[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[groff] 14/18: [gropdf]: Add font subsetting and Type 1 parser.
|
From: |
G. Branden Robinson |
|
Subject: |
[groff] 14/18: [gropdf]: Add font subsetting and Type 1 parser. |
|
Date: |
Wed, 3 Jan 2024 06:54:48 -0500 (EST) |
gbranden pushed a commit to branch master
in repository groff.
commit 77fb2e809de402252fd2c241a5f2c6899ea2f3fe
Author: Deri James <deri@chuzzlewit.myzen.co.uk>
AuthorDate: Sat Nov 4 17:56:21 2023 -0500
[gropdf]: Add font subsetting and Type 1 parser.
* src/devices/gropdf/gropdf.pl: There are two main areas of change. The
first is rectifying my design mistake in the original gropdf. It used
the "t" command from groff as the primary command as a series of input
characters which would be converted to postscript glyphs, all other
text commands (for example "c") were converted back to their input
character and treated as a single character "t" command. I was
focussed on the groff font rather than the postscript font.
While thinking about font subsetting it became clear it made more
sense to convert all input to postscript glyph names immediately, and
use them as the "common currency" rather than focus on words. This
particularly makes sense when dealing with non-latin input which has
been processed with preconv. It is also makes it much more natural
when dealing with font subsetting. Previously this was not necessary
because the whole font was embedded by gropdf.
The second major change is the addition of a type 1 font parser and
code to generate a font which only contains the glyphs required by the
document being processed. This is the area which needs the most
testing. I have tested with dozens of fonts that this parser is
robust enough, but there are thousands of fonts out there. It seems
to be happy with fonts produced by fontforge, which is promising.
[This commit fails no tests on my system and all gropdf-generated
documents appear to render without regression on casual inspection:
groff-man-pages.pdf, automake.pdf, sboxes.pdf, and the several mom
examples. There also remain several more changes from Deri's branch to
land. Nevertheless, attentive human testing is much desired! --GBR]
---
ChangeLog | 30 +
src/devices/gropdf/gropdf.pl | 2891 ++++++++++++++++++++++++++++--------------
2 files changed, 1981 insertions(+), 940 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index a11dab7d1..70696ce8f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,33 @@
+2024-01-03 Deri James <deri@chuzzlewit.myzen.co.uk>
+
+ [gropdf]: Add font subsetting and Type 1 font parser.
+
+ * src/devices/gropdf/gropdf.pl: There are two main areas of
+ change. The first is rectifying my design mistake in the
+ original gropdf. It used the "t" command from groff as the
+ primary command as a series of input characters which would be
+ converted to postscript glyphs, all other text commands (for
+ example "c") were converted back to their input character and
+ treated as a single character "t" command. I was focussed on
+ the groff font rather than the postscript font.
+
+ While thinking about font subsetting it became clear it made
+ more sense to convert all input to postscript glyph names
+ immediately, and use them as the "common currency" rather than
+ focus on words. This particularly makes sense when dealing with
+ non-latin input which has been processed with preconv. It is
+ also makes it much more natural when dealing with font
+ subsetting. Previously this was not necessary because the whole
+ font was embedded by gropdf.
+
+ The second major change is the addition of a type 1 font parser
+ and code to generate a font which only contains the glyphs
+ required by the document being processed. This is the area
+ which needs the most testing. I have tested with dozens of
+ fonts that this parser is robust enough, but there are thousands
+ of fonts out there. It seems to be happy with fonts produced by
+ fontforge, which is promising.
+
2024-01-02 G. Branden Robinson <g.branden.robinson@gmail.com>
* src/preproc/tbl/tbl.1.man (roff interface): Fix incorrect
diff --git a/src/devices/gropdf/gropdf.pl b/src/devices/gropdf/gropdf.pl
index 9a61b839b..224f0e4b7 100644
--- a/src/devices/gropdf/gropdf.pl
+++ b/src/devices/gropdf/gropdf.pl
@@ -2,7 +2,7 @@
#
# gropdf : PDF post processor for groff
#
-# Copyright (C) 2011-2020 Free Software Foundation, Inc.
+# Copyright (C) 2011-2023 Free Software Foundation, Inc.
# Written by Deri James <deri@chuzzlewit.myzen.co.uk>
#
# This file is part of groff.
@@ -22,37 +22,260 @@
use strict;
use warnings;
+require 5.8.0;
use Getopt::Long qw(:config bundling);
+use Encode qw(encode);
use POSIX qw(mktime);
use constant
{
- WIDTH => 0,
- CHRCODE => 1,
- PSNAME => 2,
- ASSIGNED => 3,
- USED => 4,
+ WIDTH => 0,
+ CHRCODE => 1,
+ PSNAME => 2,
+ MINOR => 3,
+ MAJOR => 4,
+ UNICODE => 5,
+
+ CHR => 0,
+ XPOS => 1,
+ CWID => 2,
+ HWID => 3,
+ NOMV => 4,
+ CHF => 5,
+
+ MAGIC1 => 52845,
+ MAGIC2 => 22719,
+ C_DEF => 4330,
+ E_DEF => 55665,
+
+ LINE => 0,
+ CALLS => 1,
+ NEWNO => 2,
+ CHARCHAR => 3,
+
+ NUMBER => 0,
+ LENGTH => 1,
+ STR => 2,
+ TYPE => 3,
+
+ SUBSET => 1,
+ USESPACE => 2,
+ COMPRESS => 4,
+ NOFILE => 8,
};
+my %StdEnc=(
+ 32 => 'space',
+ 33 => '!',
+ 34 => 'dq',
+ 35 => 'sh',
+ 36 => 'Do',
+ 37 => '%',
+ 38 => '&',
+ 39 => 'cq',
+ 40 => '(',
+ 41 => ')',
+ 42 => '*',
+ 43 => '+',
+ 44 => ',',
+ 45 => 'hy',
+ 46 => '.',
+ 47 => 'sl',
+ 48 => '0',
+ 49 => '1',
+ 50 => '2',
+ 51 => '3',
+ 52 => '4',
+ 53 => '5',
+ 54 => '6',
+ 55 => '7',
+ 56 => '8',
+ 57 => '9',
+ 58 => ':',
+ 59 => ';',
+ 60 => '<',
+ 61 => '=',
+ 62 => '>',
+ 63 => '?',
+ 64 => 'at',
+ 65 => 'A',
+ 66 => 'B',
+ 67 => 'C',
+ 68 => 'D',
+ 69 => 'E',
+ 70 => 'F',
+ 71 => 'G',
+ 72 => 'H',
+ 73 => 'I',
+ 74 => 'J',
+ 75 => 'K',
+ 76 => 'L',
+ 77 => 'M',
+ 78 => 'N',
+ 79 => 'O',
+ 80 => 'P',
+ 81 => 'Q',
+ 82 => 'R',
+ 83 => 'S',
+ 84 => 'T',
+ 85 => 'U',
+ 86 => 'V',
+ 87 => 'W',
+ 88 => 'X',
+ 89 => 'Y',
+ 90 => 'Z',
+ 91 => 'lB',
+ 92 => 'rs',
+ 93 => 'rB',
+ 94 => 'ha',
+ 95 => '_',
+ 96 => 'oq',
+ 97 => 'a',
+ 98 => 'b',
+ 99 => 'c',
+ 100 => 'd',
+ 101 => 'e',
+ 102 => 'f',
+ 103 => 'g',
+ 104 => 'h',
+ 105 => 'i',
+ 106 => 'j',
+ 107 => 'k',
+ 108 => 'l',
+ 109 => 'm',
+ 110 => 'n',
+ 111 => 'o',
+ 112 => 'p',
+ 113 => 'q',
+ 114 => 'r',
+ 115 => 's',
+ 116 => 't',
+ 117 => 'u',
+ 118 => 'v',
+ 119 => 'w',
+ 120 => 'x',
+ 121 => 'y',
+ 122 => 'z',
+ 123 => 'lC',
+ 124 => 'ba',
+ 125 => 'rC',
+ 126 => 'ti',
+ 161 => 'r!',
+ 162 => 'ct',
+ 163 => 'Po',
+ 164 => 'f/',
+ 165 => 'Ye',
+ 166 => 'Fn',
+ 167 => 'sc',
+ 168 => 'Cs',
+ 169 => 'aq',
+ 170 => 'lq',
+ 171 => 'Fo',
+ 172 => 'fo',
+ 173 => 'fc',
+ 174 => 'fi',
+ 175 => 'fl',
+ 177 => 'en',
+ 178 => 'dg',
+ 179 => 'dd',
+ 180 => 'pc',
+ 182 => 'ps',
+ 183 => 'bu',
+ 184 => 'bq',
+ 185 => 'Bq',
+ 186 => 'rq',
+ 187 => 'Fc',
+ 188 => 'u2026',
+ 189 => '%0',
+ 191 => 'r?',
+ 193 => 'ga',
+ 194 => 'aa',
+ 195 => 'a^',
+ 196 => 'a~',
+ 197 => 'a-',
+ 198 => 'ab',
+ 199 => 'a.',
+ 200 => 'ad',
+ 202 => 'ao',
+ 203 => 'ac',
+ 205 => 'a"',
+ 206 => 'ho',
+ 207 => 'ah',
+ 208 => 'em',
+ 225 => 'AE',
+ 227 => 'Of',
+ 232 => '/L',
+ 233 => '/O',
+ 234 => 'OE',
+ 235 => 'Om',
+ 241 => 'ae',
+ 245 => '.i',
+ 248 => '/l',
+ 249 => '/o',
+ 250 => 'oe',
+ 251 => 'ss',
+);
+
my $prog=$0;
+unshift(@ARGV,split(' ',$ENV{GROPDF_OPTIONS})) if exists($ENV{GROPDF_OPTIONS});
my $gotzlib=0;
+my $gotinline=0;
my $rc = eval
{
- require Compress::Zlib;
- Compress::Zlib->import();
- 1;
+ require Compress::Zlib;
+ Compress::Zlib->import();
+ 1;
};
if($rc)
{
- $gotzlib=1;
+ $gotzlib=1;
}
else
{
Warn("Perl module 'Compress::Zlib' not available; cannot compress"
- . " this PDF");
+ . " this PDF");
+}
+
+mkdir $ENV{HOME}.'/_Inline' if !-e $ENV{HOME}.'/_Inline' and
!exists($ENV{PERL_INLINE_DIRECTORY}) and exists($ENV{HOME});
+
+$rc = eval
+{
+ require Inline;
+ Inline->import (C => Config => DIRECTORY => $ENV{HOME}.'/_Inline') if
!exists($ENV{PERL_INLINE_DIRECTORY}) and exists($ENV{HOME});
+ Inline->import (C =><<'EOC');
+
+ static const uint32_t MAGIC1 = 52845;
+ static const uint32_t MAGIC2 = 22719;
+
+ typedef unsigned char byte;
+
+ char* decrypt_exec_C(char *s, int len)
+ {
+ static uint16_t er=55665;
+ byte clr=0;
+ int i;
+ er=55665;
+
+ for (i=0; i < len; i++)
+ {
+ byte cypher = s[i];
+ clr = (byte)(cypher ^ (er >> 8));
+ er = (uint16_t)((cypher + er) * MAGIC1 + MAGIC2);
+ s[i] = clr;
+ }
+
+ return(s);
+ }
+
+EOC
+};
+
+if($rc)
+{
+ $gotinline=1;
}
my %cfg;
@@ -62,57 +285,54 @@ $cfg{GROFF_FONT_PATH}='@GROFF_FONT_DIR@';
$cfg{RT_SEP}='@RT_SEP@';
binmode(STDOUT);
-my @obj; # Array of PDF objects
-my $objct=0; # Count of Objects
-my $fct=0; # Output count
+my @obj; # Array of PDF objects
+my $objct=0; # Count of Objects
+my $fct=0; # Output count
my %fnt; # Used fonts
-my $lct=0; # Input Line Count
+my $lct=0; # Input Line Count
my $src_name='';
my %env; # Current environment
-my %fontlst; # Fonts Loaded
-my $rot=0; # Portrait
-my %desc; # Contents of DESC
-my %download; # Contents of downlopad file
-my $pages; # Pointer to /Pages object
+my %fontlst; # Fonts Loaded
+my $rot=0; # Portrait
+my %desc; # Contents of DESC
+my %download; # Contents of downlopad file
+my $pages; # Pointer to /Pages object
my $devnm='devpdf';
-my $cpage; # Pointer to current pages
-my $cpageno=0; # Object no of current page
+my $cpage; # Pointer to current pages
+my $cpageno=0; # Object no of current page
my $cat; # Pointer to catalogue
-my $dests; # Pointer to Dests
+my $dests; # Pointer to Dests
my @mediabox=(0,0,595,842);
my @defaultmb=(0,0,595,842);
-my $stream=''; # Current Text/Graphics stream
-my $cftsz=10; # Current font sz
+my $stream=''; # Current Text/Graphics stream
+my $cftsz=10; # Current font sz
my $cft; # Current Font
-my $lwidth=1; # current linewidth
+my $lwidth=1; # current linewidth
my $linecap=1;
my $linejoin=1;
-my $textcol=''; # Current groff text
-my $fillcol=''; # Current groff fill
-my $curfill=''; # Current PDF fill
+my $textcol=''; # Current groff text
+my $fillcol=''; # Current groff fill
+my $curfill=''; # Current PDF fill
my $strkcol='';
my $curstrk='';
-my @lin=(); # Array holding current line of text
-my @ahead=(); # Buffer used to hol the next line
-my $mode='g'; # Graphic (g) or Text (t) mode;
-my $xpos=0; # Current X position
-my $ypos=0; # Current Y position
+my @lin=(); # Array holding current line of text
+my @ahead=(); # Buffer used to hol the next line
+my $mode='g'; # Graphic (g) or Text (t) mode;
+my $xpos=0; # Current X position
+my $ypos=0; # Current Y position
my $tmxpos=0;
my $kernadjust=0;
my $curkern=0;
-my $widtbl; # Pointer to width table for current font size
-my $origwidtbl; # Pointer to width table
-my $krntbl; # Pointer to kern table
+my $krntbl; # Pointer to kern table
my $matrix="1 0 0 1";
-my $whtsz; # Current width of a space
-my $poschg=0; # V/H pending
-my $fontchg=0; # font change pending
-my $tnum=2; # flatness of B-Spline curve
-my $tden=3; # flatness of B-Spline curve
+my $whtsz; # Current width of a space
+my $wt;
+my $poschg=0; # V/H pending
+my $fontchg=0; # font change pending
+my $tnum=2; # flatness of B-Spline curve
+my $tden=3; # flatness of B-Spline curve
my $linewidth=40;
my $w_flg=0;
-my $nomove=0;
-my $pendmv=0;
my $gotT=0;
my $suppress=0; # Suppress processing?
my %incfil; # Included Files
@@ -121,19 +341,18 @@ my $curoutlev=\@outlev;
my $curoutlevno=0; # Growth point for @curoutlev
my $Foundry='';
my $xrev=0; # Reverse x direction of font
+my $inxrev=0;
my $matrixchg=0;
-my $wt=-1;
my $thislev=1;
my $mark=undef;
my $suspendmark=undef;
my $boxmax=0;
my %missing; # fonts in download files which are not found/readable
-
-
+my @PageLabel; # PageLabels
my $n_flg=1;
my $pginsert=-1; # Growth point for kids array
-my %pgnames; # 'names' of pages for switchtopage
+my %pgnames; # 'names' of pages for switchtopage
my @outlines=(); # State of Bookmark Outlines at end of each page
my $custompaper=0; # Has there been an X papersize
my $textenccmap=''; # CMap for groff text.enc encoding
@@ -144,41 +363,41 @@ my $transition={PAGE => {Type => '/Trans', S => '', D =>
1, Dm => '/H', M => '/I
BLOCK => {Type => '/Trans', S => '', D => 1, Dm => '/H', M =>
'/I', Di => 0, SS => 1.0, B => 0}};
my $firstpause=0;
my $present=0;
-my @bgstack; # Stack of background boxes
-my $bgbox=''; # Draw commands for boxes on this page
+my @bgstack; # Stack of background boxes
+my $bgbox=''; # Draw commands for boxes on this page
$noslide=1 if exists($ENV{GROPDF_NOSLIDE}) and $ENV{GROPDF_NOSLIDE};
my %ppsz=(
- 'ledger'=>[1224,792],
- 'legal'=>[612,1008],
- 'letter'=>[612,792],
- 'a0'=>[2384,3370],
- 'a1'=>[1684,2384],
- 'a2'=>[1191,1684],
- 'a3'=>[842,1191],
- 'a4'=>[595,842],
- 'a5'=>[420,595],
- 'a6'=>[297,420],
- 'a7'=>[210,297],
- 'a8'=>[148,210],
- 'a9'=>[105,148],
- 'a10'=>[73,105],
- 'b0'=>[2835,4008],
- 'b1'=>[2004,2835],
- 'b2'=>[1417,2004],
- 'b3'=>[1001,1417],
- 'b4'=>[709,1001],
- 'b5'=>[499,709],
- 'b6'=>[354,499],
- 'c0'=>[2599,3677],
- 'c1'=>[1837,2599],
- 'c2'=>[1298,1837],
- 'c3'=>[918,1298],
- 'c4'=>[649,918],
- 'c5'=>[459,649],
- 'c6'=>[323,459],
- 'com10'=>[297,684],
+ 'ledger'=>[1224,792],
+ 'legal'=>[612,1008],
+ 'letter'=>[612,792],
+ 'a0'=>[2384,3370],
+ 'a1'=>[1684,2384],
+ 'a2'=>[1191,1684],
+ 'a3'=>[842,1191],
+ 'a4'=>[595,842],
+ 'a5'=>[420,595],
+ 'a6'=>[297,420],
+ 'a7'=>[210,297],
+ 'a8'=>[148,210],
+ 'a9'=>[105,148],
+ 'a10'=>[73,105],
+ 'b0'=>[2835,4008],
+ 'b1'=>[2004,2835],
+ 'b2'=>[1417,2004],
+ 'b3'=>[1001,1417],
+ 'b4'=>[709,1001],
+ 'b5'=>[499,709],
+ 'b6'=>[354,499],
+ 'c0'=>[2599,3677],
+ 'c1'=>[1837,2599],
+ 'c2'=>[1298,1837],
+ 'c3'=>[918,1298],
+ 'c4'=>[649,918],
+ 'c5'=>[459,649],
+ 'c6'=>[323,459],
+ 'com10'=>[297,684],
);
my $ucmap=<<'EOF';
@@ -195,9 +414,8 @@ begincmap
1 begincodespacerange
<0000> <FFFF>
endcodespacerange
-2 beginbfrange
-<008b> <008f> [<00660066> <00660069> <0066006c> <006600660069> <00660066006C>]
-<00ad> <00ad> <002d>
+1 beginbfrange
+<001f> <001f> <002d>
endbfrange
endcmap
CMapName currentdict /CMap defineresource pop
@@ -233,13 +451,29 @@ my $want_help=0;
my $version=0;
my $stats=0;
my $unicodemap;
+my $options=7;
+my $PDFver=1.7;
my @idirs;
+my $alloc=-1;
+my $cftmajor=0;
+my $lenIV=4;
+my %sec;
+my $Glyphs='';
+my (@glyphused,@subrused,%glyphseen);
+my $newsub=4;
+my $term="\n";
+my @bl;
+my %seac;
+my $thisfnt;
+my $parcln=qr/\[[^\]]*?\]|(?<term>.)((?!\g{term}).)*\g{term}/;
+my $parclntyp=qr/(?:[\d\w]|\([+-]?[\S]{2}|$parcln)/;
+
if (!GetOptions('F=s' => \$fd, 'I=s' => \@idirs, 'l' => \$frot,
- 'p=s' => \$fpsz, 'd!' => \$debug, 'help' => \$want_help,
- 'v' => \$version, 'version' => \$version,
- 'e' => \$embedall, 'y=s' => \$Foundry, 's' => \$stats,
- 'u:s' => \$unicodemap))
+ 'p=s' => \$fpsz, 'd!' => \$debug, 'help' => \$want_help, 'pdfver=f' =>
\$PDFver,
+ 'v' => \$version, 'version' => \$version, 'opt=s' => \$options,
+ 'e' => \$embedall, 'y=s' => \$Foundry, 's' => \$stats,
+ 'u:s' => \$unicodemap))
{
&usage(1);
}
@@ -262,17 +496,25 @@ if (defined($unicodemap))
}
elsif (-r $unicodemap)
{
- local $/;
- open(F,"<$unicodemap") or Die("failed to open '$unicodemap'");
- ($ucmap)=(<F>);
- close(F);
+ local $/;
+ open(F,"<$unicodemap") or Die("failed to open '$unicodemap'");
+ ($ucmap)=(<F>);
+ close(F);
}
else
{
- Warn("failed to find '$unicodemap'; ignoring");
+ Warn("failed to find '$unicodemap'; ignoring");
}
}
+if ($PDFver != 1.4 and $PDFver != 1.7)
+{
+ Warn("Only pdf versions 1.4 or 1.7 are supported, not '$PDFver'");
+ $PDFver=1.7;
+}
+
+$PDFver=int($PDFver*10)-10;
+
# Search for 'font directory': paths in -f opt, shell var
# GROFF_FONT_PATH, default paths
@@ -307,31 +549,32 @@ for $papersz ( split(" ", lc($possiblesizes).' #duff#') )
# Check for "/etc/papersize"
elsif (substr($papersz,0,1) eq '/' and -r $papersz)
{
- if (open(P,"<$papersz"))
- {
- while (<P>)
- {
- chomp;
- s/# .*//;
- next if $_ eq '';
- $papersz=lc($_);
- last;
- }
- close(P);
- }
+ if (open(P,"<$papersz"))
+ {
+ while (<P>)
+ {
+ chomp;
+ s/# .*//;
+ next if $_ eq '';
+ $papersz=lc($_);
+ last;
+ }
+ close(P);
+ }
}
- # Allow height,width specified directly in centimeters, inches, or points.
+ # Allow height,width specified directly in centimeters, inches, or
+ # points.
if ($papersz=~m/([\d.]+)([cipP]),([\d.]+)([cipP])/)
{
- @defaultmb=@mediabox=(0,0,ToPoints($3,$4),ToPoints($1,$2));
- last;
+ @defaultmb=@mediabox=(0,0,ToPoints($3,$4),ToPoints($1,$2));
+ last;
}
# Look $papersz up as a name such as "a4" or "letter".
elsif (exists($ppsz{$papersz}))
{
- @defaultmb=@mediabox=(0,0,$ppsz{$papersz}->[0],$ppsz{$papersz}->[1]);
- last;
+ @defaultmb=@mediabox=(0,0,$ppsz{$papersz}->[0],$ppsz{$papersz}->[1]);
+ last;
}
# Check for a landscape version
elsif (substr($papersz,-1) eq 'l' and exists($ppsz{substr($papersz,0,-1)}))
@@ -353,9 +596,9 @@ if ($ENV{SOURCE_DATE_EPOCH}) {
my $dt=PDFDate(\@dt);
my %info=('Creator' => "(groff version $cfg{GROFF_VERSION})",
- 'Producer' => "(gropdf version
$cfg{GROFF_VERSION})",
- 'ModDate' => "($dt)",
- 'CreationDate' => "($dt)");
+ 'Producer' => "(gropdf version $cfg{GROFF_VERSION})",
+ 'ModDate' => "($dt)",
+ 'CreationDate' => "($dt)");
map { $_="< ".$_."\0" } @ARGV;
while (<>)
@@ -364,7 +607,7 @@ while (<>)
s/\r$//;
$lct++;
- do # The ahead buffer behaves like 'ungetc'
+ do # The ahead buffer behaves like 'ungetc'
{{
if (scalar(@ahead))
{
@@ -373,7 +616,7 @@ while (<>)
my $cmd=substr($_,0,1);
- next if $cmd eq '#'; # just a comment
+ next if $cmd eq '#'; # just a comment
my $lin=substr($_,1);
while ($cmd eq 'w')
@@ -384,7 +627,7 @@ while (<>)
}
$lin=~s/^\s+//;
-# $lin=~s/\s#.*?$//; # remove comment
+# $lin=~s/\s#.*?$//; # remove comment
$stream.="\% $_\n" if $debug;
do_x($lin),next if ($cmd eq 'x');
@@ -407,119 +650,342 @@ while (<>)
my $tmp=scalar(@ahead);
}} until scalar(@ahead) == 0;
-
}
exit 0 if $lct==0;
if ($cpageno > 0)
{
- my $trans='BLOCK';
+ my $trans='BLOCK';
+
+ $trans='PAGE' if $firstpause;
- $trans='PAGE' if $firstpause;
+ if (scalar(@XOstream))
+ {
+ MakeXO() if $stream;
+ $stream=join("\n",@XOstream)."\n";
+ }
+
+ my %t=%{$transition->{$trans}};
+ $cpage->{MediaBox}=\@mediabox if $custompaper;
+ $cpage->{Trans}=FixTrans(\%t) if $t{S};
+
+ if ($#PageAnnots >= 0)
+ {
+ @{$cpage->{Annots}}=@PageAnnots;
+ }
+
+ if ($#bgstack > -1 or $bgbox)
+ {
+ my $box="q 1 0 0 1 0 0 cm ";
- if (scalar(@XOstream))
+ foreach my $bg (@bgstack)
{
- MakeXO() if $stream;
- $stream=join("\n",@XOstream)."\n";
+ # 0=$bgtype # 1=stroke 2=fill. 4=page
+ # 1=$strkcol
+ # 2=$fillcol
+ # 3=(Left,Top,Right,bottom,LineWeight)
+ # 4=Start ypos
+ # 5=Endypos
+ # 6=Line Weight
+
+ my $pg=$bg->[3] || \@mediabox;
+
+ $bg->[5]=$pg->[3]; # box is continuing to next page
+ $box.=DrawBox($bg);
+ $bg->[4]=$pg->[1]; # will continue from page top
}
- my %t=%{$transition->{$trans}};
- $cpage->{MediaBox}=\@mediabox if $custompaper;
- $cpage->{Trans}=FixTrans(\%t) if $t{S};
+ $stream=$box.$bgbox."Q\n".$stream;
+ $bgbox='';
+ }
- if ($#PageAnnots >= 0)
+ $boxmax=0;
+ PutObj($cpageno);
+ OutStream($cpageno+1);
+}
+
+$cat->{PageMode}='/UseOutlines' if $#outlev > 0;
+$cat->{PageMode}='/FullScreen' if $present;
+
+PutOutlines(\@outlev);
+
+my $info=BuildObj(++$objct,\%info);
+
+PutObj($objct);
+
+foreach my $fontno (sort keys %fontlst)
+{
+ my $f=$fontlst{$fontno};
+ my $fnt=$f->{FNT};
+ my $nam=$fnt->{NAM};
+ my ($head,$body,$tail);
+ my $objno=$f->{OBJNO};
+ my @fontdesc=();
+ my $chars=$fnt->{TRFCHAR};
+ my $glyphs='/.notdef';
+ $glyphs.='/space' if defined($fnt->{NO}->[32]) and $fnt->{NO}->[32] eq
'u0020';
+ my $fobj;
+ @glyphused=@subrused=%seac=();
+ push(@subrused,'#0','#1','#2','#3','#4');
+ $newsub=4;
+ %sec=();
+ $thisfnt=$fnt;
+
+ for (my $j=0; $j<=$#{$chars}; $j++)
+ {
+ $glyphs.=join('',@{$fnt->{CHARSET}->[$j]});
+ }
+
+ if (exists($fnt->{fontfile}))
+ {
+ $fnt->{FONTFILE}=BuildObj(++$objct,
+ {'Length1' => 0,
+ 'Length2' => 0,
+ 'Length3' => 0
+ }
+ ), $fobj=$objct if !($options & NOFILE);
+
+ ($head,$body,$tail)=GetType1($fnt->{fontfile});
+ $head=~s/\/Encoding \d.*?readonly def\b/\/Encoding StandardEncoding
def/s;
+
+ if ($options & SUBSET)
{
- @{$cpage->{Annots}}=@PageAnnots;
+ $lenIV=$1 if $head=~m'/lenIV\s+(\d+)';
+ my $l=length($body);
+ my
$b=($gotinline)?decrypt_exec_C($body,$l):decrypt_exec_P(\$body,$l);
+ $body=substr($body,$lenIV);
+ $body=~m/begin([\r\n]+)/;
+ $term=$1;
+ if (defined($term))
+ {
+ (@bl)=split("$term",$body);
+ map_subrs(\@bl);
+ Subset(\@bl,$glyphs);
+ }
+ else
+ {
+ Warn("Unable to parse font '$fnt->{internalname}' for
subsetting")
+ }
}
+ }
- if ($#bgstack > -1 or $bgbox)
+ for (my $j=0; $j<=$#{$chars}; $j++)
+ {
+ my @differ;
+ my $firstch;
+ my $lastch=0;
+ my @widths;
+ my $miss=-1;
+ my $CharSet=join('',@{$fnt->{CHARSET}->[$j]});
+ push(@{$chars->[$j]},'u0020') if $j==0 and
$fnt->{NAM}->{u0020}->[PSNAME];
+
+ foreach my $og (sort { $nam->{$a}->[MINOR] <=> $nam->{$b}->[MINOR] }
(@{$chars->[$j]}))
{
- my $box="q 1 0 0 1 0 0 cm ";
+ my $g=$og;
- foreach my $bg (@bgstack)
+ while ($g or $g eq '0')
{
- # 0=$bgtype # 1=stroke 2=fill. 4=page
- # 1=$strkcol
- # 2=$fillcol
- # 3=(Left,Top,Right,bottom,LineWeight)
- # 4=Start ypos
- # 5=Endypos
- # 6=Line Weight
+ my ($glyph,$trf)=GetNAM($fnt,$g);
+ my $chrno=$glyph->[MINOR];
+ $firstch=$chrno if !defined($firstch);
+ $lastch=$chrno;
+ $widths[$chrno-$firstch]=$glyph->[WIDTH];
+
+ push(@differ,$chrno) if $chrno > $miss;
+ $miss=$chrno+1;
+ my $ps=$glyph->[PSNAME];
+ push(@differ,$ps);
+
+ if (exists($seac{$trf}))
+ {
+ $g=pop(@{$seac{$ps}});
+ $CharSet.=$g if $g;
+ }
+ else
+ {
+ $g='';
+ }
+ }
+ }
- my $pg=$bg->[3] || \@mediabox;
+ foreach my $w (@widths) {$w=0 if !defined($w);}
+ my $fontnm=$fontno.(($j)?".$j":'');
+ $fnt->{FirstChar}=$firstch;
+ $fnt->{LastChar}=$lastch;
+ $fnt->{Differences}=\@differ;
+ $fnt->{Widths}=\@widths;
+ $fnt->{CharSet}=$CharSet;
+ $fnt->{'ToUnicode'}=$textenccmap if $j==0 and $CharSet=~m'/minus';
- $bg->[5]=$pg->[3]; # box is continuing to next page
- $box.=DrawBox($bg);
- $bg->[4]=$pg->[1]; # will continue from page top
+ $objct++;
+ push(@fontdesc,EmbedFont($fontnm,$fnt));
+ $pages->{'Resources'}->{'Font'}->{'F'.$fontnm}=$fontlst{$fontnm}->{OBJ};
+ $obj[$objct-2]->{DATA}->{'ToUnicode'}=$textenccmap if
(exists($fnt->{ToUnicode}));
+ }
+
+ if (exists($fnt->{fontfile}))
+ {
+ if ($options & SUBSET and !($options & NOFILE))
+ {
+ if (defined($term))
+ {
+ $body=encrypt(\@bl);
}
+ }
- $stream=$box.$bgbox."Q\n".$stream;
- $bgbox='';
+ if (defined($fobj))
+ {
+ $obj[$fobj]->{STREAM}=$head.$body.$tail;
+ $obj[$fobj]->{DATA}->{Length1}=length($head);
+ $obj[$fobj]->{DATA}->{Length2}=length($body);
+ $obj[$fobj]->{DATA}->{Length3}=length($tail);
}
- $boxmax=0;
- PutObj($cpageno);
- OutStream($cpageno+1);
+ foreach my $o (@fontdesc)
+ {
+ $obj[$o]->{DATA}->{FontFile}=$fnt->{FONTFILE} if !($options &
NOFILE);
+ if ($options & SUBSET)
+ {
+ my $nm='/'.SubTag().$fnt->{internalname};
+ $obj[$o]->{DATA}->{FontName}=$nm;
+ $obj[$o-2]->{DATA}->{BaseFont}=$nm;
+ }
+ }
+ }
}
-$cat->{PageMode}='/FullScreen' if $present;
+foreach my $j (0..$#{$pages->{Kids}})
+{
+ my $pg=GetObj($pages->{Kids}->[$j]);
-PutOutlines(\@outlev);
+ if (defined($PageLabel[$j]))
+ {
+ push(@{$cat->{PageLabels}->{Nums}},$j,$PageLabel[$j]);
+ }
+}
-PutObj(1);
+if (exists($cat->{PageLabels}) and $cat->{PageLabels}->{Nums}->[0] != 0)
+{
+ unshift(@{$cat->{PageLabels}->{Nums}},0,{S => "/D"});
+}
-my $info=BuildObj(++$objct,\%info);
+PutObj(1);
+PutObj(2);
-PutObj($objct);
+my $objidx=-1;
+my @obji;
+my $tobjct=$objct;
+my $omaj=-1;
-foreach my $fontno (sort keys %fontlst)
+foreach my $o (3..$objct)
{
- my $o=$fontlst{$fontno}->{FNT};
-
- foreach my $ch (@{$o->{NO}})
+ if (!exists($obj[$o]->{XREF}))
{
- my $psname=$o->{NAM}->{$ch->[1]}->[PSNAME] || '/.notdef';
- my $wid=$o->{NAM}->{$ch->[1]}->[WIDTH] || 0;
+ if ($PDFver!=4 and !exists($obj[$o]->{STREAM}) and
ref($obj[$o]->{DATA}) eq 'HASH')
+ {
+ # This can be put into an ObjStm
+ my $maj=int(++$objidx/128);
+ my $min=$objidx % 128;
- push(@{$o->{DIFF}},$psname);
- push(@{$o->{WIDTH}},$wid);
- last if $#{$o->{DIFF}} >= 256;
- }
- unshift(@{$o->{DIFF}},0);
- my $p=GetObj($fontlst{$fontno}->{OBJ});
+ if ($maj > $omaj)
+ {
+ $omaj=$maj;
+ BuildObj(++$tobjct,
+ {
+ 'Type' => '/ObjStm',
+ }
+ );
- if (exists($p->{LastChar}) and $p->{LastChar} > 255)
- {
- $p->{LastChar} = 255;
- splice(@{$o->{DIFF}},257);
- splice(@{$o->{WIDTH}},257);
+ $obji[$maj]=[$tobjct,0,'',''];
+ $obj[$tobjct]->{DATA}->{Extends}=($tobjct-1)." 0 R" if $maj > 0;
+ }
+
+ $obj[$o]->{INDIRECT}=[$tobjct,$min];
+ $obji[$maj]->[1]++;
+ $obji[$maj]->[2].=' ' if $obji[$maj]->[2];
+ $obji[$maj]->[2].="$o ".length($obji[$maj]->[3]);
+ PutObj($o,\$obji[$maj]->[3]);
+ }
+ else
+ {
+ PutObj($o);
+ }
}
}
-foreach my $o (3..$objct)
+foreach my $maj (0..$#obji)
{
- PutObj($o) if (!exists($obj[$o]->{XREF}));
+ my $obji=$obji[$maj];
+ my $objno=$obji->[0];
+
+ $obj[$objno]->{DATA}->{N}=$obji->[1];
+ $obj[$objno]->{DATA}->{First}=length($obji->[2]);
+ $obj[$objno]->{STREAM}=$obji->[2].$obji->[3];
+ PutObj($objno);
}
+$objct=$tobjct;
+
#my $encrypt=BuildObj(++$objct,{'Filter' => '/Standard', 'V' => 1, 'R' => 2,
'P' => 252});
#PutObj($objct);
-PutObj(2);
my $xrefct=$fct;
$objct+=1;
-print "xref\n0 $objct\n0000000000 65535 f \n";
-foreach my $xr (@obj)
+if ($PDFver == 4)
{
- next if !defined($xr);
- printf("%010d 00000 n \n",$xr->{XREF});
+ print "xref\n0 $objct\n0000000000 65535 f \n";
+
+ foreach my $j (1..$#obj)
+ {
+ my $xr=$obj[$j];
+ next if !defined($xr);
+ printf("%010d 00000 n \n",$xr->{XREF});
+ }
+
+ print "trailer\n<<\n/Info $info\n/Root 1 0 R\n/Size $objct\n>>\n";
}
+else
+{
+ BuildObj($objct++,
+ {
+ 'Type' => '/XRef',
+ 'W' => [1, 4, 1],
+ 'Info' => $info,
+ 'Root' => "1 0 R",
+ 'Size' => $objct,
+ });
-print "trailer\n<<\n/Info $info\n/Root 1 0 R\n/Size
$objct\n>>\nstartxref\n$fct\n\%\%EOF\n";
-print "\% Pages=$pages->{Count}\n" if $stats;
+ $stream=pack('CNC',0,0,0);
+
+ foreach my $j (1..$#obj)
+ {
+ my $xr=$obj[$j];
+ next if !defined($xr);
+
+ if (exists($xr->{INDIRECT}))
+ {
+ $stream.=pack('CNC',2,@{$xr->{INDIRECT}});
+ }
+ else
+ {
+ if (exists($xr->{XREF}))
+ {
+ $stream.=pack('CNC',1,$xr->{XREF},0);
+ }
+ }
+ }
+
+ $stream.=pack('CNC',1,$fct,0);
+ $obj[$objct-1]->{STREAM}=$stream;
+ PutObj($objct-1);
+ print "trailer\n<<\n/Root 1 0 R\n/Size $objct\n>>\n";
+}
+print "startxref\n$xrefct\n\%\%EOF\n";
+print "\% Pages=$pages->{Count}\n" if $stats;
sub MakeMatrix
{
@@ -539,13 +1005,13 @@ sub MakeMatrix
$slant*=$env{FontHT}/$cftsz if $env{FontHT} != 0;
my $ang=rad($slant);
- $mat[2]=sprintf('%.3f',sin($ang)/cos($ang));
- }
+ $mat[2]=sprintf('%.3f',sin($ang)/cos($ang));
+ }
- if ($fontxrev)
- {
- $mat[0]=-$mat[0];
- }
+ if ($fontxrev)
+ {
+ $mat[0]=-$mat[0];
+ }
}
$matrix=join(' ',@mat);
@@ -629,8 +1095,6 @@ sub GetObj
return($obj[$ono]->{DATA});
}
-
-
sub PDFDate
{
my $dt=shift;
@@ -674,7 +1138,7 @@ sub ToPoints
}
else
{
- Die("invalid scaling unit '$unit'");
+ Die("invalid scaling unit '$unit'");
}
}
@@ -704,19 +1168,19 @@ sub LoadDownload
$file=substr($file,1);
}
- my $pth=$file;
- $pth=$dir."/$devnm/$file" if substr($file,0,1) ne '/';
+ my $pth=$file;
+ $pth=$dir."/$devnm/$file" if substr($file,0,1) ne '/';
- if (!-r $pth)
- {
- $missing{"$foundry $name"}="$dir/$devnm";
- next;
- }
+ if (!-r $pth)
+ {
+ $missing{"$foundry $name"}="$dir/$devnm";
+ next;
+ }
- $download{"$foundry $name"}=$file if !exists($download{"$foundry
$name"});
+ $download{"$foundry $name"}=$file if !exists($download{"$foundry
$name"});
}
- close($f);
+ close($f);
}
Die("failed to open 'download' file") if !$found;
@@ -747,7 +1211,7 @@ sub LoadDesc
OpenFile(\$f,$fontdir,"DESC");
Die("failed to open device description file 'DESC'")
- if !defined($f);
+ if !defined($f);
while (<$f>)
{
@@ -762,35 +1226,35 @@ sub LoadDesc
foreach my $directive ('unitwidth', 'res', 'sizescale')
{
- Die("device description file 'DESC' missing mandatory directive"
- . " '$directive'") if !exists($desc{$directive});
+ Die("device description file 'DESC' missing mandatory directive"
+ . " '$directive'") if !exists($desc{$directive});
}
foreach my $directive ('unitwidth', 'res', 'sizescale')
{
- my $val=$desc{$directive};
- Die("device description file 'DESC' directive '$directive'"
- . " value must be positive; got '$val'")
- if ($val !~ m/^\d+$/ or $val <= 0);
+ my $val=$desc{$directive};
+ Die("device description file 'DESC' directive '$directive'"
+ . " value must be positive; got '$val'")
+ if ($val !~ m/^\d+$/ or $val <= 0);
}
if (exists($desc{'hor'}))
{
- my $hor=$desc{'hor'};
- Die("device horizontal motion quantum must be 1, got '$hor'")
- if ($hor != 1);
+ my $hor=$desc{'hor'};
+ Die("device horizontal motion quantum must be 1, got '$hor'")
+ if ($hor != 1);
}
if (exists($desc{'vert'}))
{
- my $vert=$desc{'vert'};
- Die("device vertical motion quantum must be 1, got '$vert'")
- if ($vert != 1);
+ my $vert=$desc{'vert'};
+ Die("device vertical motion quantum must be 1, got '$vert'")
+ if ($vert != 1);
}
my ($res,$ss)=($desc{'res'},$desc{'sizescale'});
Die("device resolution must be a multiple of 72*sizescale, got"
- . " '$res' ('sizescale'=$ss)") if (($res % ($ss * 72)) != 0);
+ . " '$res' ('sizescale'=$ss)") if (($res % ($ss * 72)) != 0);
}
sub rad { $_[0]*3.14159/180 }
@@ -805,10 +1269,10 @@ sub do_x
if ($xcmd eq 'T')
{
- Warn("expecting a PDF pipe (got $xprm[0])")
- if $xprm[0] ne substr($devnm,3);
+ Warn("expecting a PDF pipe (got $xprm[0])")
+ if $xprm[0] ne substr($devnm,3);
}
- elsif ($xcmd eq 'f') # Register Font
+ elsif ($xcmd eq 'f') # Register Font
{
$xprm[1]="${Foundry}-$xprm[1]" if $Foundry ne '';
LoadFont($xprm[0],$xprm[1]);
@@ -836,22 +1300,21 @@ sub do_x
$objct++;
@defaultmb=@mediabox;
BuildObj($objct,{'Pages' => BuildObj($objct+1,
- {'Kids' => [],
- 'Count' => 0,
- 'Type' => '/Pages',
- 'Rotate' => $rot,
- 'MediaBox' => \@defaultmb,
- 'Resources' =>
- {'Font' => {},
- 'ProcSet' => ['/PDF', '/Text', '/ImageB',
'/ImageC', '/ImageI']}
- }
- ),
- 'Type' => '/Catalog'});
+ {'Kids' => [],
+ 'Count' => 0,
+ 'Type' => '/Pages',
+ 'Rotate' => $rot,
+ 'MediaBox' => \@defaultmb,
+ 'Resources' => {'Font' => {},
+ 'ProcSet' => ['/PDF', '/Text', '/ImageB', '/ImageC',
'/ImageI']}
+ }
+ ),
+ 'Type' => '/Catalog'});
$cat=$obj[$objct]->{DATA};
$objct++;
$pages=$obj[2]->{DATA};
- Put("%PDF-1.4\n\x25\xe2\xe3\xcf\xd3\n");
+ Put("%PDF-1.$PDFver\n\x25\xe2\xe3\xcf\xd3\n");
}
}
elsif ($xcmd eq 'X')
@@ -899,8 +1362,8 @@ sub do_x
my ($x,$y)=PtoR($theta+$curangle,$hyp);
my ($tx, $ty) = ($xpos - $x, GraphY($ypos) - $y);
if ($frot) {
- ($tx, $ty) = ($tx * sin($theta) + $ty * -cos($theta),
- $tx * -cos($theta) + $ty * -sin($theta));
+ ($tx, $ty) = ($tx * sin($theta) + $ty * -cos($theta),
+ $tx * -cos($theta) + $ty * -sin($theta));
}
$stream.="q\n".sprintf("%.3f %.3f %.3f %.3f %.3f %.3f
cm",cos($theta),sin($theta),-sin($theta),cos($theta),$tx,$ty)."\n";
$InPicRotate=1;
@@ -966,7 +1429,7 @@ sub do_x
{
MakeXO();
NewPage('BLOCK');
- $cat->{PageMode}='/FullScreen';
+ $present=1;
pop(@XOstream);
}
}
@@ -975,7 +1438,7 @@ sub do_x
my $pdfmark=$1;
$pdfmark=~s((\d{4,6}) u)(sprintf("%.1f",$1/$desc{sizescale}))eg;
$pdfmark=~s(\\\[u00(..)\])(chr(hex($1)))eg;
- $pdfmark=~s/\\n/\n/g;
+ $pdfmark=~s/\\n/\n/g;
if ($pdfmark=~m/(.+) \/DOCINFO\s*$/s)
{
@@ -984,7 +1447,7 @@ sub do_x
foreach my $k (sort keys %{$docinfo})
{
- $info{$k}=$docinfo->{$k} if $k ne 'Producer';
+ $info{$k}='('.utf16(substr($docinfo->{$k},1,-1)).')' if
$k ne 'Producer';
}
}
elsif ($pdfmark=~m/(.+) \/DOCVIEW\s*$/)
@@ -999,12 +1462,13 @@ sub do_x
}
elsif ($pdfmark=~m/(.+) \/DEST\s*$/)
{
- my @xwds=split(' ',"<< $1 >>");
- my $dest=ParsePDFValue(\@xwds);
- $dest->{View}->[1]=GraphY($dest->{View}->[1]*-1);
- unshift(@{$dest->{View}},"$cpageno 0 R");
+ my @xwds=split(' ',"<< $1 >>");
+ my $dest=ParsePDFValue(\@xwds);
+ $dest->{Dest}=UTFName($dest->{Dest});
+ $dest->{View}->[1]=GraphY($dest->{View}->[1]*-1);
+ unshift(@{$dest->{View}},"$cpageno 0 R");
- if (!defined($dests))
+ if (!defined($dests))
{
$cat->{Dests}=BuildObj(++$objct,{});
$dests=$obj[$objct]->{DATA};
@@ -1026,6 +1490,8 @@ sub do_x
$annot->{DATA}->{Type}='/Annot';
FixRect($annot->{DATA}->{Rect}); # Y origin to ll
FixPDFColour($annot->{DATA});
+ $annot->{DATA}->{Dest}=UTFName($annot->{DATA}->{Dest}) if
exists($annot->{DATA}->{Dest});
+
$annot->{DATA}->{A}->{URI}=URIName($annot->{DATA}->{A}->{URI}) if
exists($annot->{DATA}->{A}->{URI});
push(@PageAnnots,$annotno);
}
elsif ($pdfmark=~m/(.+) \/OUT\s*$/)
@@ -1035,10 +1501,11 @@ sub do_x
$t=~s/\\e/\\\\/g;
$t=~m/(^.*\/Title \()(.*)(\).*)/;
my ($pre,$title,$post)=($1,$2,$3);
- $title=~s/(?<!\\)\(/\\\(/g;
- $title=~s/(?<!\\)\)/\\\)/g;
+ $title=utf16($title);
+
my @xwds=split(' ',"<< $pre$title$post >>");
my $out=ParsePDFValue(\@xwds);
+ $out->{Dest}=UTFName($out->{Dest});
my $this=[$out,[]];
@@ -1146,13 +1613,13 @@ sub do_x
}
$incfil{$fil}=LoadSWF($fil,[$llx,$lly,$urx,$ury],$mat);
- }
- else
- {
- Warn("unrecognized 'import' file type '$fil'");
- return undef;
- }
- }
+ }
+ else
+ {
+ Warn("unrecognized 'import' file type '$fil'");
+ return undef;
+ }
+ }
if (defined($incfil{$fil}))
{
@@ -1218,13 +1685,13 @@ sub do_x
}
}
elsif (lc($xprm[1]) eq 'xrev')
- {
- $xrev=!$xrev;
- }
- elsif (lc($xprm[1]) eq 'markstart')
- {
- $mark={'rst' => ($xprm[2]+$xprm[4])/$unitwidth, 'rsb' =>
($xprm[3]-$xprm[4])/$unitwidth, 'xpos' => $xpos-($xprm[4]/$unitwidth),
- 'ypos' => $ypos, 'lead' => $xprm[4]/$unitwidth,
'pdfmark' => join(' ',@xprm[5..$#xprm])};
+ {
+ $xrev=!$xrev;
+ }
+ elsif (lc($xprm[1]) eq 'markstart')
+ {
+ $mark={'rst' => ($xprm[2]+$xprm[4])/$unitwidth, 'rsb' =>
($xprm[3]-$xprm[4])/$unitwidth, 'xpos' => $xpos-($xprm[4]/$unitwidth),
+ 'ypos' => $ypos, 'lead' => $xprm[4]/$unitwidth, 'pdfmark'
=> join(' ',@xprm[5..$#xprm])};
}
elsif (lc($xprm[1]) eq 'markend')
{
@@ -1301,30 +1768,30 @@ sub do_x
{
$pginsert=$j;
last FIND;
- }
- else
- {
- # XXX: indentation wince
- Warn(
-"expected 'switchtopage' parameter to be one of"
-. "'top|bottom|before|after', got '$ba'");
- last FIND;
- }
- }
-
- }
-
- Warn("cannot find page ref '$ref'");
- last FIND
-
- }
+ }
+ else
+ {
+ # XXX: indentation wince
+ Warn(
+ "expected 'switchtopage'
parameter to be one of"
+ .
"'top|bottom|before|after', got '$ba'");
+ last FIND;
+ }
+ }
+
+ }
+
+ Warn("cannot find page ref '$ref'");
+ last FIND
+
+ }
}
- }
- else
- {
- Warn("cannot find page named '$want'");
- }
- }
+ }
+ else
+ {
+ Warn("cannot find page named '$want'");
+ }
+ }
if ($pginsert < 0)
{
@@ -1333,6 +1800,7 @@ sub do_x
else
{
($curoutlev,$curoutlevno,$thislev)=(@{$outlines[$pginsert]});
+ $curoutlevno--;
}
}
}
@@ -1374,22 +1842,22 @@ sub do_x
my $sptr=$#bgstack;
if ($sptr > -1)
{
- if ($sptr == 0 and $bgstack[0]->[0] & 4)
- {
- pop(@bgstack);
- }
- else
- {
- $bgstack[$sptr]->[5]=GraphY($ypos);
- $bgbox=DrawBox(pop(@bgstack)).$bgbox;
+ if ($sptr == 0 and $bgstack[0]->[0] & 4)
+ {
+ pop(@bgstack);
+ }
+ else
+ {
+ $bgstack[$sptr]->[5]=GraphY($ypos);
+ $bgbox=DrawBox(pop(@bgstack)).$bgbox;
+ }
}
}
- }
elsif (lc($type) eq 'footnote')
{
- my $t=GetPoints($xprm[0]);
- $boxmax=($t<0)?abs($t):GraphY($t);
- }
+ my $t=GetPoints($xprm[0]);
+ $boxmax=($t<0)?abs($t):GraphY($t);
+ }
else
{
my $bgtype=0;
@@ -1419,53 +1887,207 @@ sub do_x
if ($bgtype)
{
- if ($bgtype & 4)
- {
- shift(@bgstack) if $#bgstack >= 0 and
$bgstack[0]->[0] & 4;
-
unshift(@bgstack,[$bgtype,$strkcol,$fillcol,$bg,GraphY($ypos),GraphY($bg[3]||0),$bgwt
|| 0.4]);
- }
- else
- {
-
push(@bgstack,[$bgtype,$strkcol,$fillcol,$bg,GraphY($ypos),GraphY($bg[3]||0),$bgwt
|| 0.4]);
+ if ($bgtype & 4)
+ {
+ shift(@bgstack) if $#bgstack >= 0 and
$bgstack[0]->[0] & 4;
+
unshift(@bgstack,[$bgtype,$strkcol,$fillcol,$bg,GraphY($ypos),GraphY($bg[3]||0),$bgwt
|| 0.4]);
+ }
+ else
+ {
+
push(@bgstack,[$bgtype,$strkcol,$fillcol,$bg,GraphY($ypos),GraphY($bg[3]||0),$bgwt
|| 0.4]);
+ }
}
}
}
- }
+ elsif (lc($xprm[1]) eq 'pagenumbering')
+ {
+ # 2=type of [D=decimal,R=Roman,r=roman,A=Alpha
(uppercase),a=alpha (lowercase)
+ # 3=prefix label
+ # 4=start number
+
+ my ($S,$P,$St);
+
+ $xprm[2]='' if !$xprm[2] or $xprm[2] eq '.';
+ $xprm[3]='' if defined($xprm[3]) and $xprm[3] eq '.';
+
+ if ($xprm[2] and index('DRrAa',substr($xprm[2],0,1)) == -1)
+ {
+ Warn("Page numbering type '$xprm[2]' is not recognised");
+ }
+ else
+ {
+ $S=substr($xprm[2],0,1) if $xprm[2];
+ $P=$xprm[3];
+ $St=$xprm[4] if length($xprm[4]);
+
+ if (!defined($S) and !length($P))
+ {
+ $P=' ';
+ }
+
+ if ($St and $St!~m/^-?\d+$/)
+ {
+ Warn("Page numbering start '$St' must be numeric");
+ return;
+ }
+
+ $cat->{PageLabels}={Nums => []} if
!exists($cat->{PageLabels});
+
+ my $label={};
+ $label->{S} = "/$S" if $S;
+ $label->{P} = "($P)" if length($P);
+ $label->{St} = $St if length($St);
+
+ $#PageLabel=$pginsert if $pginsert > $#PageLabel;
+ splice(@PageLabel,$pginsert,0,$label);
+ }
+ }
+
}
elsif (lc(substr($xprm[0],0,9)) eq 'papersize')
{
- my ($px,$py)=split(',',substr($xprm[0],10));
- $px=GetPoints($px);
- $py=GetPoints($py);
- @mediabox=(0,0,$px,$py);
- my @mb=@mediabox;
- $matrixchg=1;
- $custompaper=1;
- $cpage->{MediaBox}=\@mb;
+ if (!($xprm[1] and $xprm[1] eq 'tmac' and $fpsz))
+ {
+ my ($px,$py)=split(',',substr($xprm[0],10));
+ $px=GetPoints($px);
+ $py=GetPoints($py);
+ @mediabox=(0,0,$px,$py);
+ my @mb=@mediabox;
+ $matrixchg=1;
+ $custompaper=1;
+ $cpage->{MediaBox}=\@mb;
+ }
}
}
}
-sub FixPDFColour
+sub URIName
{
- my $o=shift;
- my $a=$o->{C};
- my @r=();
- my $c=$a->[0];
+ my $s=shift;
- if ($#{$a}==3)
- {
- if ($c > 1)
- {
- foreach my $j (0..2)
- {
- push(@r,sprintf("%1.3f",$a->[$j]/0xffff));
- }
+ $s=Clean($s);
+ $s=~s/\\\[u((?i)D[89AB]\p{AHex}{2})\] # High surrogate in range
0xD800–0xDBFF
+ \\\[u((?i)D[CDEF]\p{AHex}{2})\] # Low surrogate in range
0xDC00–0xDFFF
+ /chr( ((hex($1) - 0xD800) * 0x400) + (hex($2) - 0xDC00) + 0x10000
)/xge;
+ $s=~s/\\\[u(\p{AHex}{4})]/chr hex $1/ge;
- $o->{C}=\@r;
- }
- }
- elsif (substr($c,0,1) eq '#')
+ return(join '', map {(m/[-\w.~_]/)?chr($_):'%'.sprintf("%02X", $_)} unpack
"C*", encode('utf8',$s));
+}
+
+sub Clean
+{
+ my $p=shift;
+
+ $p=~s/\\c?$//g;
+ $p=~s/\\[eE]/\\/g;
+ $p=~s/\\[ 0~t]/ /g;
+ $p=~s/\\[,!"#\$%&’.0:?{}ˆ_‘|^prud]//g;
+ $p=~s/\\'/\\[aa]/g;
+ $p=~s/\\`/\\[ga]/g;
+ $p=~s/\\_/\\[ul]/g;
+ $p=~s/\\-/-/g;
+
+ $p=~s/\\[Oz].//g;
+ $p=~s/\\[ABbDHlLoRSvwXZ]$parcln//g;
+ $p=~s/\\[hs][-+]?$parclntyp//g;
+ $p=~s/\\[FfgkMmnVY]$parclntyp//g;
+
+ $p=~s/\\\((\w\w)/\\\[$1\]/g; # convert \(xx to \[xx]
+
+ return $p;
+}
+
+sub utf16
+{
+ my $p=Clean(shift);
+
+ $p=~s/\\\[(.*?)\]/FindChr($1,0)/eg;
+ $p=~s/\\C($parcln)/FindChr($1,1)/eg;
+# $p=~s/\\\((..)/FindChr($1)/eg;
+ $p=~s/\\N($parcln)/FindChr($1,1,1)/eg;
+
+ if ($p =~ /[^[:ascii:]]/)
+ {
+ $p = join '', map sprintf("\\%o", $_),
+ unpack "C*", encode('utf16', $p);
+ }
+
+ $p=~s/(?<!\\)\(/\\\(/g;
+ $p=~s/(?<!\\)\)/\\\)/g;
+
+ return($p);
+}
+
+sub FindChr
+{
+ my $ch=shift;
+ my $subsflg=shift;
+ my $cn=shift;
+
+ return('') if !defined($ch);
+ $ch=substr($ch,1,-1) if $subsflg;
+ $ch=$thisfnt->{NO}->[$ch] if defined($cn);
+ return('') if !defined($ch);
+ return pack('U',hex($1)) if $ch=~m/^u([0-9A-F]{4,5})$/;
+
+ if (exists($thisfnt->{NAM}->{$ch}))
+ {
+ if ($thisfnt->{NAM}->{$ch}->[PSNAME]=~m/\\u(?:ni)?([0-9A-F]{4,5})/)
+ {
+ return pack('U',hex($1));
+ }
+ elsif (defined($thisfnt->{NAM}->{$ch}->[UNICODE]))
+ {
+ return pack('U',hex($thisfnt->{NAM}->{$ch}->[UNICODE]))
+ }
+ }
+ elsif ($ch=~m/^\w+$/) # ligature not in font i.e. \(ff
+ {
+ return $ch;
+ }
+
+ Warn("Can't convert '$ch' to unicode");
+
+ return('');
+}
+
+sub UTFName
+{
+ my $s=shift;
+ my $r='';
+
+ $s=substr($s,1);
+ return '/'.join '', map { MakeLabel($_) } unpack('C*',$s);
+
+}
+
+sub MakeLabel
+{
+ my $c=chr(shift);
+ return($c) if $c=~m/[\w:]/;
+ return(sprintf("#%02x",ord($c)));
+}
+
+sub FixPDFColour
+{
+ my $o=shift;
+ my $a=$o->{C};
+ my @r=();
+ my $c=$a->[0];
+
+ if ($#{$a}==3)
+ {
+ if ($c > 1)
+ {
+ foreach my $j (0..2)
+ {
+ push(@r,sprintf("%1.3f",$a->[$j]/0xffff));
+ }
+
+ $o->{C}=\@r;
+ }
+ }
+ elsif (substr($c,0,1) eq '#')
{
if (length($c) == 7)
{
@@ -1503,6 +2125,8 @@ sub PutHotSpot
$annot->{DATA}->{Rect}=[$mark->{xpos},$mark->{ypos}-$mark->{rsb},$endx+$mark->{lead},$mark->{ypos}-$mark->{rst}];
FixPDFColour($annot->{DATA});
FixRect($annot->{DATA}->{Rect}); # Y origin to ll
+ $annot->{DATA}->{Dest}=UTFName($annot->{DATA}->{Dest}) if
exists($annot->{DATA}->{Dest});
+ $annot->{DATA}->{A}->{URI}=URIName($annot->{DATA}->{A}->{URI}) if
exists($annot->{DATA}->{A});
push(@PageAnnots,$annotno);
}
@@ -1556,11 +2180,11 @@ sub GetPoints
# sub BuildRef
# {
-# my $fil=shift;
-# my $bbox=shift;
-# my $mat=shift;
-# my $wid=($bbox->[2]-$bbox->[0])*$mat->[0];
-# my $hgt=($bbox->[3]-$bbox->[1])*$mat->[3];
+# my $fil=shift;
+# my $bbox=shift;
+# my $mat=shift;
+# my $wid=($bbox->[2]-$bbox->[0])*$mat->[0];
+# my $hgt=($bbox->[3]-$bbox->[1])*$mat->[3];
#
# if (!open(PDF,"<$fil"))
# {
@@ -1568,27 +2192,27 @@ sub GetPoints
# return(undef);
# }
#
-# my (@f)=(<PDF>);
+# my (@f)=(<PDF>);
#
-# close(PDF);
+# close(PDF);
#
-# $objct++;
-# my $xonm="XO$objct";
+# $objct++;
+# my $xonm="XO$objct";
#
-# $pages->{'Resources'}->{'XObject'}->{$xonm}=BuildObj($objct,{'Type' =>
'/XObject',
-# 'Subtype'
=> '/Form',
-# 'BBox' =>
$bbox,
-# 'Matrix' =>
$mat,
-# 'Resources'
=> $pages->{'Resources'},
-# 'Ref' =>
{'Page' => '1',
-#
'F' => BuildObj($objct+1,{'Type' => '/Filespec',
-#
'F' => "($fil)",
-#
'EF' => {'F' => BuildObj($objct+2,{'Type' =>
'/EmbeddedFile'})}
-#
})
-# }
-# });
+# $pages->{'Resources'}->{'XObject'}->{$xonm}=BuildObj($objct,{'Type' =>
'/XObject',
+# 'Subtype'
=> '/Form',
+# 'BBox' =>
$bbox,
+# 'Matrix'
=> $mat,
+#
'Resources' => $pages->{'Resources'},
+# 'Ref' =>
{'Page' => '1',
+#
'F' => BuildObj($objct+1,{'Type' => '/Filespec',
+#
'F' => "($fil)",
+#
'EF' => {'F' => BuildObj($objct+2,{'Type' =>
'/EmbeddedFile'})}
+#
})
+# }
+# });
#
-# $obj[$objct]->{STREAM}="q 1 0 0 1 0 0 cm
+# $obj[$objct]->{STREAM}="q 1 0 0 1 0 0 cm
# q BT
# 1 0 0 1 0 0 Tm
# .5 g .5 G
@@ -1598,13 +2222,13 @@ sub GetPoints
# 0 0 m 72 0 l s
# Q\n";
#
-# # $obj[$objct]->{STREAM}=PutXY($xpos,$ypos)." m
".PutXY($xpos+$wid,$ypos)." l ".PutXY($xpos+$wid,$ypos+$hgt)." l
".PutXY($xpos,$ypos+$hgt)." l f\n";
-# $obj[$objct+2]->{STREAM}=join('',@f);
-# PutObj($objct);
-# PutObj($objct+1);
-# PutObj($objct+2);
-# $objct+=2;
-# return($xonm);
+# # $obj[$objct]->{STREAM}=PutXY($xpos,$ypos)." m
".PutXY($xpos+$wid,$ypos)." l ".PutXY($xpos+$wid,$ypos+$hgt)." l
".PutXY($xpos,$ypos+$hgt)." l f\n";
+# $obj[$objct+2]->{STREAM}=join('',@f);
+# PutObj($objct);
+# PutObj($objct+1);
+# PutObj($objct+2);
+# $objct+=2;
+# return($xonm);
# }
sub LoadSWF
@@ -1619,8 +2243,8 @@ sub LoadSWF
if (!open(PDF,"<$fil"))
{
- Warn("failed to open SWF '$fil'");
- return(undef);
+ Warn("failed to open SWF '$fil'");
+ return(undef);
}
my (@f)=(<PDF>);
@@ -1635,9 +2259,9 @@ sub LoadSWF
PutObj($objct);
$objct++;
my $asset=BuildObj($objct,{'EF' => {'F' => BuildObj($objct+1,{})},
- 'F' => "($node)",
- 'Type' => '/Filespec',
- 'UF' => "($node)"});
+ 'F' => "($node)",
+ 'Type' => '/Filespec',
+ 'UF' => "($node)"});
PutObj($objct);
$objct++;
@@ -1645,7 +2269,7 @@ sub LoadSWF
PutObj($objct);
$objct++;
my $config=BuildObj($objct,{'Instances' => [BuildObj($objct+1,{'Params' =>
{ 'Binding' => '/Background'}, 'Asset' => $asset})],
- 'Subtype' => '/Flash'});
+ 'Subtype' => '/Flash'});
PutObj($objct);
$objct++;
@@ -1655,16 +2279,16 @@ sub LoadSWF
my ($x,$y)=split(' ',PutXY($xpos,$ypos));
push(@{$cpage->{Annots}},BuildObj($objct,{'RichMediaContent' => {'Subtype'
=> '/Flash', 'Configurations' => [$config], 'Assets' => {'Names' => [
"($node)", $asset ] }},
- 'P' => "$cpageno 0 R",
- 'RichMediaSettings' => { 'Deactivation' => {
'Condition' => '/PI',
- 'Type' =>
'/RichMediaDeactivation'},
- 'Activation' => { 'Condition' => '/PV',
- 'Type' =>
'/RichMediaActivation'}},
- 'F' => 68,
- 'Subtype' => '/RichMedia',
- 'Type' => '/Annot',
- 'Rect' => "[ $x $y ".($x+$wid)." ".($y+$hgt)." ]",
- 'Border' => [0,0,0]}));
+ 'P' => "$cpageno 0 R",
+ 'RichMediaSettings' => { 'Deactivation'
=> { 'Condition' => '/PI',
+ 'Type' => '/RichMediaDeactivation'},
+ 'Activation' => { 'Condition' => '/PV',
+ 'Type' => '/RichMediaActivation'}},
+ 'F' => 68,
+ 'Subtype' => '/RichMedia',
+ 'Type' => '/Annot',
+ 'Rect' => "[ $x $y ".($x+$wid)."
".($y+$hgt)." ]",
+ 'Border' => [0,0,0]}));
PutObj($objct);
@@ -1720,8 +2344,8 @@ sub LoadPDF
if (!defined($PD))
{
- Warn("failed to open PDF '$pdfnm'");
- return undef;
+ Warn("failed to open PDF '$pdfnm'");
+ return undef;
}
my $hdr=<$PD>;
@@ -1768,13 +2392,13 @@ sub LoadPDF
$pdf->[$curobj]->{STREAMPOS}=[tell($PD)+$adj,$strmlen];
seek($PD,$strmlen,1);
$instream=1;
- }
- else
- {
- Warn("parsing PDF '$pdfnm' failed");
- return undef;
- }
- }
+ }
+ else
+ {
+ Warn("parsing PDF '$pdfnm' failed");
+ return undef;
+ }
+ }
s/%.*?$//;
$pdftxt.=$_.' ';
@@ -1783,7 +2407,7 @@ sub LoadPDF
close($PD);
open(PD,"<$PDnm");
-# $pdftxt=~s/\]/ \]/g;
+# $pdftxt=~s/\]/ \]/g;
my (@pdfwds)=split(' ',$pdftxt);
my $wd;
my $root;
@@ -1796,27 +2420,27 @@ sub LoadPDF
shift(@pdfwds); shift(@pdfwds);
unshift(@pdfwds,$1) if defined($1) and length($1);
$pdf->[$curobj]->{OBJ}=ParsePDFObj(\@pdfwds);
- my $o=$pdf->[$curobj];
+ my $o=$pdf->[$curobj];
- if (ref($o->{OBJ}) eq 'HASH' and exists($o->{OBJ}->{Type}) and
$o->{OBJ}->{Type} eq '/ObjStm')
- {
- LoadStream($o,$pdf);
- my $pos=$o->{OBJ}->{First};
- my $s=$o->{STREAM};
- my @o=split(' ',substr($s,0,$pos));
- substr($s,0,$pos)='';
- push(@o,-1,length($s));
-
- for (my $j=0; $j<=$#o-2; $j+=2)
- {
- my @w=split(' ',substr($s,$o[$j+1],$o[$j+3]-$o[$j+1]));
- $pdf->[$o[$j]]->{OBJ}=ParsePDFObj(\@w);
- }
+ if (ref($o->{OBJ}) eq 'HASH' and exists($o->{OBJ}->{Type}) and
$o->{OBJ}->{Type} eq '/ObjStm')
+ {
+ LoadStream($o,$pdf);
+ my $pos=$o->{OBJ}->{First};
+ my $s=$o->{STREAM};
+ my @o=split(' ',substr($s,0,$pos));
+ substr($s,0,$pos)='';
+ push(@o,-1,length($s));
+
+ for (my $j=0; $j<=$#o-2; $j+=2)
+ {
+ my @w=split(' ',substr($s,$o[$j+1],$o[$j+3]-$o[$j+1]));
+ $pdf->[$o[$j]]->{OBJ}=ParsePDFObj(\@w);
+ }
- $pdf->[$curobj]=undef;
- }
+ $pdf->[$curobj]=undef;
+ }
- $root=$curobj if ref($pdf->[$curobj]->{OBJ}) eq 'HASH' and
exists($pdf->[$curobj]->{OBJ}->{Type}) and $pdf->[$curobj]->{OBJ}->{Type} eq
'/XRef';
+ $root=$curobj if ref($pdf->[$curobj]->{OBJ}) eq 'HASH' and
exists($pdf->[$curobj]->{OBJ}->{Type}) and $pdf->[$curobj]->{OBJ}->{Type} eq
'/XRef';
}
elsif ($wd eq 'trailer' and !exists($pdf->[0]->{OBJ}))
{
@@ -1824,7 +2448,7 @@ sub LoadPDF
}
else
{
-# print "Skip '$wd'\n";
+# print "Skip '$wd'\n";
}
}
@@ -1839,8 +2463,8 @@ sub LoadPDF
{
if (exists($o->{STREAMPOS}) and !exists($o->{STREAM}))
{
- LoadStream($o,$pdf);
- }
+ LoadStream($o,$pdf);
+ }
}
close(PD);
@@ -1876,10 +2500,11 @@ sub LoadPDF
# Map inserted objects to current PDF
MapInsValue($pdf,$page,'',$insmap,$xobj,$pdf->[$page]->{OBJ});
-#
-# Many PDFs include 'Resources' at the 'Page' level but if 'Resources' is
held at a higher level (i.e 'Pages')
-# then we need to include its objects as well.
-#
+ #
+ # Many PDFs include 'Resources' at the 'Page' level but if
+ # 'Resources' is held at a higher level (i.e 'Pages') then we need
+ # to include its objects as well.
+ #
MapInsValue($pdf,$page,'',$insmap,$xobj,$res) if
!exists($pdf->[$page]->{OBJ}->{Resources});
# Copy Resources
@@ -1893,8 +2518,8 @@ sub LoadPDF
if ($BBox->[0] != 0 or $BBox->[1] != 0)
{
- my (@matrix)=(1,0,0,1,-$BBox->[0],-$BBox->[1]);
- $obj[$xobj]->{DATA}->{Matrix}=\@matrix;
+ my (@matrix)=(1,0,0,1,-$BBox->[0],-$BBox->[1]);
+ $obj[$xobj]->{DATA}->{Matrix}=\@matrix;
}
BuildStream($xobj,$pdf,$pdf->[$page]->{OBJ}->{Contents});
@@ -1914,16 +2539,16 @@ sub LoadStream
$l=$pdf->[$$l]->{OBJ} if (defined($l) && ref($l) eq 'OBJREF');
Die("unable to determine length of stream \@$o->{STREAMPOS}->[0]")
- if !defined($l);
+ if !defined($l);
sysseek(PD,$o->{STREAMPOS}->[0],0);
Warn("failed to read all of the stream")
- if $l != sysread(PD,$o->{STREAM},$l);
+ if $l != sysread(PD,$o->{STREAM},$l);
if ($gotzlib and exists($o->{OBJ}->{'Filter'}) and $o->{OBJ}->{'Filter'}
eq '/FlateDecode')
{
- $o->{STREAM}=Compress::Zlib::uncompress($o->{STREAM});
- delete($o->{OBJ }->{'Filter'});
+ $o->{STREAM}=Compress::Zlib::uncompress($o->{STREAM});
+ delete($o->{OBJ }->{'Filter'});
}
}
@@ -1946,7 +2571,7 @@ sub BuildStream
}
else
{
- Warn("unexpected 'Contents'");
+ Warn("unexpected 'Contents'");
}
foreach my $o (@{$objs})
@@ -1958,7 +2583,6 @@ sub BuildStream
$obj[$xobj]->{STREAM}=$strm;
}
-
sub MapInsHash
{
my $pdf=shift;
@@ -1967,7 +2591,6 @@ sub MapInsHash
my $parent=shift;
my $val=shift;
-
foreach my $k (sort keys(%{$val}))
{
MapInsValue($pdf,$o,$k,$insmap,$parent,$val->{$k}) if $k ne 'Contents';
@@ -2016,7 +2639,6 @@ sub MapInsValue
{
MapInsHash($pdf,$o,$insmap,$parent,$val);
}
-
}
sub FindKey
@@ -2079,23 +2701,30 @@ sub NextPage
sub nextwd
{
my $pdfwds=shift;
+ my $instring=shift || 0;
my $wd=shift(@{$pdfwds});
return('') if !defined($wd);
+ return($wd) if $instring;
if ($wd=~m/^(.*?)(<<|>>|(?:(?<!\\)\[|\]))(.*)/)
{
- if (defined($1) and length($1))
+ my ($p1,$p2,$p3)=($1,$2,$3);
+
+ if (defined($p1) and length($p1))
{
- unshift(@{$pdfwds},$3) if defined($3) and length($3);
- unshift(@{$pdfwds},$2);
- $wd=$1;
+ if (!($p2 eq ']' and $p1=~m/\[/))
+ {
+ unshift(@{$pdfwds},$p3) if defined($p3) and length($p3);
+ unshift(@{$pdfwds},$p2);
+ $wd=$p1;
+ }
}
else
{
- unshift(@{$pdfwds},$3) if defined($3) and length($3);
- $wd=$2;
+ unshift(@{$pdfwds},$p3) if defined($p3) and length($p3);
+ $wd=$p2;
}
}
@@ -2104,7 +2733,6 @@ sub nextwd
sub ParsePDFObj
{
-
my $pdfwds=shift;
my $rtn;
my $wd;
@@ -2144,12 +2772,12 @@ sub ParsePDFHash
my (@w)=split('/',$wd,3);
- if ($w[0])
- {
- Warn("PDF Dict Key '$wd' does not start with '/'");
- exit 1;
- }
- else
+ if ($w[0])
+ {
+ Warn("PDF Dict Key '$wd' does not start with '/'");
+ exit 1;
+ }
+ else
{
unshift(@{$pdfwds},"/$w[2]") if $w[2];
$wd=$w[1];
@@ -2251,16 +2879,16 @@ sub ParsePDFString
if ($lev<=0 and $wd=~m/^(.*?\))([^)]+)$/)
- {
- unshift(@{$pdfwds},$2) if defined($2) and length($2);
- $wd=$1;
- }
+ {
+ unshift(@{$pdfwds},$2) if defined($2) and length($2);
+ $wd=$1;
+ }
- $rtn.=$wd;
+ $rtn.=$wd;
last if $lev <= 0;
- $wd=nextwd($pdfwds);
+ $wd=nextwd($pdfwds,1);
}
return($rtn);
@@ -2318,11 +2946,11 @@ sub Msg
if ($fatal)
{
- print STDERR "fatal error: ";
+ print STDERR "fatal error: ";
}
else
{
- print STDERR "warning: ";
+ print STDERR "warning: ";
}
print STDERR "$msg\n";
@@ -2369,11 +2997,19 @@ sub Put
sub PutObj
{
my $ono=shift;
+ my $inmem=shift;
+
+ if ($inmem)
+ {
+ PutField($inmem,$obj[$ono]->{DATA});
+ return;
+ }
+
my $msg="$ono 0 obj ";
$obj[$ono]->{XREF}=$fct;
if (exists($obj[$ono]->{STREAM}))
{
- if ($gotzlib && !$debug && !exists($obj[$ono]->{DATA}->{'Filter'}))
+ if ($gotzlib && ($options & COMPRESS) && !$debug &&
!exists($obj[$ono]->{DATA}->{'Filter'}))
{
$obj[$ono]->{STREAM}=Compress::Zlib::compress($obj[$ono]->{STREAM});
$obj[$ono]->{DATA}->{'Filter'}='/FlateDecode';
@@ -2409,21 +3045,21 @@ sub PutField
elsif ($typ eq 'ARRAY')
{
$$pmsg.='[';
- foreach my $cell (@{$fld})
- {
- PutField($pmsg,$cell,' ');
- }
- $$pmsg.="]$term";
+ foreach my $cell (@{$fld})
+ {
+ PutField($pmsg,$cell,' ');
+ }
+ $$pmsg.="]$term";
}
elsif ($typ eq 'HASH')
{
$$pmsg.='<< ';
- foreach my $key (sort keys %{$fld})
- {
- $$pmsg.="/$key ";
- PutField($pmsg,$fld->{$key});
- }
- $$pmsg.=">>$term";
+ foreach my $key (sort keys %{$fld})
+ {
+ $$pmsg.="/$key ";
+ PutField($pmsg,$fld->{$key});
+ }
+ $$pmsg.=">>$term";
}
elsif ($typ eq 'OBJREF')
{
@@ -2441,6 +3077,52 @@ sub BuildObj
return("$ono 0 R ");
}
+sub EmbedFont
+{
+ my $fontno=shift;
+ my $fnt=shift;
+ my $st=$objct;
+
+ $fontlst{$fontno}->{OBJ}=BuildObj($objct,
+ {
+ 'Type' => '/Font',
+ 'Subtype' => '/Type1',
+ 'BaseFont' => '/'.$fnt->{internalname},
+ 'Widths' => $fnt->{Widths},
+ 'FirstChar' => $fnt->{FirstChar},
+ 'LastChar' => $fnt->{LastChar},
+ 'Encoding' => BuildObj($objct+1,
+ {
+ 'Type' => '/Encoding',
+ 'Differences' => $fnt->{Differences}
+ }),
+ 'FontDescriptor' => BuildObj($objct+2,
+ {
+ 'Type' => '/FontDescriptor',
+ 'FontName' => '/'.$fnt->{internalname},
+ 'Flags' => $fnt->{t1flags},
+ 'FontBBox' => $fnt->{fntbbox},
+ 'ItalicAngle' => $fnt->{slant},
+ 'Ascent' => $fnt->{ascent},
+ 'Descent' => $fnt->{fntbbox}->[1],
+ 'CapHeight' => $fnt->{capheight},
+ 'StemV' => 0,
+ 'CharSet' => "($fnt->{CharSet})",
+ } )
+ }
+ );
+
+ $fontlst{$fontno}->{OBJNO}=$objct;
+
+ $objct+=2;
+ $fontlst{$fontno}->{NM}='/F'.$fontno;
+ $pages->{'Resources'}->{'Font'}->{'F'.$fontno}=$fontlst{$fontno}->{OBJ};
+# $fontlst{$fontno}->{FNT}=$fnt;
+# $obj[$objct]->{STREAM}=$t1stream;
+
+ return($st+2);
+}
+
sub LoadFont
{
my $fontno=shift;
@@ -2456,7 +3138,7 @@ sub LoadFont
{
# Try with no foundry
$fontnm=~s/.*?-//;
- OpenFile(\$f,$fontdir,$fontnm);
+ OpenFile(\$f,$fontdir,$fontnm);
}
Die("unable to open font '$ofontnm' for mounting") if !defined($f);
@@ -2497,7 +3179,6 @@ sub LoadFont
$stg=3,next if lc($_) eq 'charset';
my ($ch1,$ch2,$k)=split;
-# $fnt{KERN}->{$ch1}->{$ch2}=$k;
}
else
{
@@ -2506,19 +3187,18 @@ sub LoadFont
if ($r[1] eq '"')
{
- $fnt{NAM}->{$r[0]}=[@{$fnt{NAM}->{$lastnm}}];
+ $fnt{NAM}->{$r[0]}=$fnt{NAM}->{$lastnm};
next;
}
$r[3]=oct($r[3]) if substr($r[3],0,1) eq '0';
$r[0]='u0020' if $r[3] == 32;
- $r[0]="u00".hex($r[3]) if $r[0] eq '---';
-# next if $r[3] >255;
- $r[4]=$r[0] if !defined($r[4]);
- $fnt{NAM}->{$r[0]}=[$p[0],$r[3],'/'.$r[4],$r[3],0];
- $fnt{NO}->[$r[3]]=[$r[0],$r[0]];
- $lastnm=$r[0];
- $lastchr=$r[3] if $r[3] > $lastchr;
+ $r[0]="u00".hex($r[3]) if $r[0] eq '---';
+ $r[4]=$r[0] if !defined($r[4]);
+ $fnt{NAM}->{$r[0]}=[$p[0],$r[3],'/'.$r[4],undef,undef,$r[5]];
+ $fnt{NO}->[$r[3]]=$r[0];
+ $lastnm=$r[0];
+ $lastchr=$r[3] if $r[3] > $lastchr;
$fixwid=$p[0] if $fixwid == -1;
$fixwid=-2 if $fixwid > 0 and $p[0] != $fixwid;
@@ -2533,120 +3213,62 @@ sub LoadFont
close($f);
- foreach my $j (0..$lastchr)
- {
- $fnt{NO}->[$j]=['',''] if !defined($fnt{NO}->[$j]);
- }
-
+ $fnt{NAM}->{u0020}->[MINOR]=32;
+ $fnt{NAM}->{u0020}->[MAJOR]=0;
my $fno=0;
my $slant=0;
$fnt{DIFF}=[];
$fnt{WIDTH}=[];
+ $fnt{fntbbox}=\@fntbbox;
+ $fnt{ascent}=$ascent;
+ $fnt{capheight}=$capheight;
+ $fnt{lastchr}=$lastchr;
$fnt{NAM}->{''}=[0,-1,'/.notdef',-1,0];
$slant=-$fnt{'slant'} if exists($fnt{'slant'});
- $fnt{'spacewidth'}=700 if !exists($fnt{'spacewidth'});
+ $fnt{slant}=$slant;
+ $fnt{nospace}=(!defined($fnt{NAM}->{u0020}->[PSNAME]) or
$fnt{NAM}->{u0020}->[PSNAME] ne '/space' or !exists($fnt{'spacewidth'}))?1:0;
+ $fnt{'spacewidth'}=270 if !exists($fnt{'spacewidth'});
+ Warn("Using nospace mode for font '$ofontnm'") if $fnt{nospace} == 1 and
$options & USESPACE;
$t1flags|=2**0 if $fixwid > -1;
$t1flags|=(exists($fnt{'special'}))?2**2:2**5;
- $t1flags|=2**6 if $slant != 0;
+ $t1flags|=2**6 if $fnt{slant} != 0;
+ $fnt{t1flags}=$t1flags;
my $fontkey="$foundry $fnt{internalname}";
+ Warn("\nFont '$fnt{internalname} ($ofontnm)' has $lastchr glyphs\n"
+ ."You would see a noticeable speedup if you install the perl module
Inline::C\n") if !$gotinline and $lastchr > 1000;
+
if (exists($download{$fontkey}))
{
- # Not a Base Font
- my ($l1,$l2,$l3,$t1stream)=GetType1($download{$fontkey});
- Warn("incorrect font format for '$fontkey' ($l1)")
- if !defined($t1stream);
- $fno=++$objct;
- $fontlst{$fontno}->{OBJ}=BuildObj($objct,
- {'Type' => '/Font',
- 'Subtype' => '/Type1',
- 'BaseFont' => '/'.$fnt{internalname},
- 'Widths' => $fnt{WIDTH},
- 'FirstChar' => 0,
- 'LastChar' => $lastchr,
- 'Encoding' => BuildObj($objct+1,
- {'Type' => '/Encoding',
- 'Differences' => $fnt{DIFF}
- }
- ),
- 'FontDescriptor' => BuildObj($objct+2,
- {'Type' => '/FontDescriptor',
- 'FontName' => '/'.$fnt{internalname},
- 'Flags' => $t1flags,
- 'FontBBox' => \@fntbbox,
- 'ItalicAngle' => $slant,
- 'Ascent' => $ascent,
- 'Descent' => $fntbbox[1],
- 'CapHeight' => $capheight,
- 'StemV' => 0,
-# 'CharSet' => "($charset)",
- 'FontFile' => BuildObj($objct+3,
- {'Length1' => $l1,
- 'Length2' => $l2,
- 'Length3' => $l3
- }
- )
- }
- )
- }
- );
-
- $objct+=3;
- $fontlst{$fontno}->{NM}='/F'.$fontno;
- $pages->{'Resources'}->{'Font'}->{'F'.$fontno}=$fontlst{$fontno}->{OBJ};
- $fontlst{$fontno}->{FNT}=\%fnt;
- $obj[$objct]->{STREAM}=$t1stream;
-
+ # Real font needs subsetting
+ $fnt{fontfile}=$download{$fontkey};
+# my ($head,$body,$tail)=GetType1($download{$fontkey});
+# $head=~s/\/Encoding .*?readonly def\b/\/Encoding StandardEncoding def/s;
+# $fontlst{$fontno}->{HEAD}=$head;
+# $fontlst{$fontno}->{BODY}=$body;
+# $fontlst{$fontno}->{TAIL}=$tail;
+# $fno=++$objct;
+# EmbedFont($fontno,\%fnt);
}
else
{
- if (exists($missing{$fontkey}))
- {
- Warn("The download file in '$missing{$fontkey}' "
- . " has erroneous entry for '$fnt{internalname} ($ofontnm)'");
- }
- else
- {
- Warn("unable to embed font file for '$fnt{internalname}'"
- . " ($ofontnm) (missing entry in 'download' file?)")
- if $embedall;
- }
- $fno=++$objct;
- $fontlst{$fontno}->{OBJ}=BuildObj($objct,
- {'Type' => '/Font',
- 'Subtype' => '/Type1',
- 'BaseFont' => '/'.$fnt{internalname},
- 'Widths' => $fnt{WIDTH},
- 'FirstChar' => 0,
- 'LastChar' => $lastchr,
- 'Encoding' => BuildObj($objct+1,
- {'Type' => '/Encoding',
- 'Differences' => $fnt{DIFF}
- }
- ),
- 'FontDescriptor' => BuildObj($objct+2,
- {'Type' => '/FontDescriptor',
- 'FontName' => '/'.$fnt{internalname},
- 'Flags' => $t1flags,
- 'FontBBox' => \@fntbbox,
- 'ItalicAngle' => $slant,
- 'Ascent' => $ascent,
- 'Descent' => $fntbbox[1],
- 'CapHeight' => $capheight,
- 'StemV' => 0,
- 'CharSet' => "($charset)",
- }
- )
- }
- );
-
- $objct+=2;
- $fontlst{$fontno}->{NM}='/F'.$fontno;
- $pages->{'Resources'}->{'Font'}->{'F'.$fontno}=$fontlst{$fontno}->{OBJ};
- $fontlst{$fontno}->{FNT}=\%fnt;
+ if (exists($missing{$fontkey}))
+ {
+ Warn("The download file in '$missing{$fontkey}' "
+ . " has erroneous entry for '$fnt{internalname} ($ofontnm)'");
+ }
+ else
+ {
+ Warn("unable to embed font file for '$fnt{internalname}'"
+ . " ($ofontnm) (missing entry in 'download' file?)")
+ if $embedall;
+ }
}
+ $fontlst{$fontno}->{NM}='/F'.$fontno;
+ $fontlst{$fontno}->{FNT}=\%fnt;
+
if (defined($fnt{encoding}) and $fnt{encoding} eq 'text.enc' and $ucmap ne
'')
{
if ($textenccmap eq '')
@@ -2655,20 +3277,19 @@ sub LoadFont
$objct++;
$obj[$objct]->{STREAM}=$ucmap;
}
- $obj[$fno]->{DATA}->{'ToUnicode'}=$textenccmap;
}
-# PutObj($fno);
-# PutObj($fno+1);
-# PutObj($fno+2) if defined($obj[$fno+2]);
-# PutObj($fno+3) if defined($obj[$fno+3]);
+# PutObj($fno);
+# PutObj($fno+1);
+# PutObj($fno+2) if defined($obj[$fno+2]);
+# PutObj($fno+3) if defined($obj[$fno+3]);
}
sub GetType1
{
my $file=shift;
my ($l1,$l2,$l3); # Return lengths
- my ($head,$body,$tail); # Font contents
+ my ($head,$body,$tail); # Font contents
my $f;
OpenFile(\$f,$fontdir,"$file");
@@ -2678,11 +3299,7 @@ sub GetType1
$body=GetChunk($f,2,"00000000") if !eof($f);
$tail=GetChunk($f,3,"cleartomark") if !eof($f);
- $l1=length($head);
- $l2=length($body);
- $l3=length($tail);
-
- return($l1,$l2,$l3,"$head$body$tail");
+ return($head,$body,$tail);
}
sub GetChunk
@@ -2716,17 +3333,17 @@ sub GetChunk
}
$type=$chunktype;
- return if $chunktype == 3;
-
- $ct=read($F,$hdr,4);
- Die("failed to read binary segment length") if $ct != 4;
- my $sl=unpack('V',$hdr);
- my $data;
- my $chk=read($F,$data,$sl);
- Die("failed to read binary segment") if $chk != $sl;
- $chunk.=$data;
- }
- else
+ return if $chunktype == 3;
+
+ $ct=read($F,$hdr,4);
+ Die("failed to read binary segment length") if $ct != 4;
+ my $sl=unpack('V',$hdr);
+ my $data;
+ my $chk=read($F,$data,$sl);
+ Die("failed to read binary segment") if $chk != $sl;
+ $chunk.=$data;
+ }
+ else
{
# ascii chunk
@@ -2742,7 +3359,7 @@ sub GetChunk
$hex=1,$enc.=" hex" if $segno == 2 and !$ct and
$lin=~m/^[A-F0-9a-f]{4,4}/;
- if ($segno !=2 and $lin=~m/^(.*$ascterm\n?)(.*)/)
+ if ($segno !=2 and $lin=~m/^(.*$ascterm[\n\r]?)(.*)/)
{
$chunk.=$1;
seek($F,-length($2)-1,1) if $2;
@@ -2849,9 +3466,9 @@ sub NewPage
my $pg=$bg->[3] || \@defaultmb;
- $bg->[5]=$pg->[3]; # box is continuing to next page
+ $bg->[5]=$pg->[3]; # box is continuing to next page
$box.=DrawBox($bg);
- $bg->[4]=$pg->[1]; # will continue from page top
+ $bg->[4]=$pg->[1]; # will continue from page top
}
$stream=$box.$bgbox."Q\n".$stream;
@@ -2866,14 +3483,23 @@ sub NewPage
$cpageno=++$objct;
my $thispg=BuildObj($objct,
- {'Type' => '/Page',
- 'Group' => {'CS' => '/DeviceRGB', 'S' => '/Transparency'},
- 'Parent' => '2 0 R',
- 'Contents' => [ BuildObj($objct+1,
- {'Length' => 0}
- ) ],
- }
- );
+ {
+ 'Type' => '/Page',
+ 'Group' =>
+ {
+ 'CS' => '/DeviceRGB',
+ 'S' => '/Transparency'
+ },
+ 'Parent' => '2 0 R',
+ 'Contents' =>
+ [
+ BuildObj($objct+1,
+ {
+ 'Length' => 0
+ } )
+ ],
+ }
+ );
splice(@{$pages->{Kids}},++$pginsert,0,$thispg);
splice(@outlines,$pginsert,0,[$curoutlev,$#{$curoutlev}+1,$thislev]);
@@ -2883,9 +3509,9 @@ sub NewPage
$pages->{'Count'}++;
$stream="q 1 0 0 1 0 0 cm\n$linejoin J\n$linecap j\n0.4 w\n";
$stream.=$strkcol."\n", $curstrk=$strkcol if $strkcol ne '';
- $mode='g';
- $curfill='';
-# @mediabox=@defaultmb;
+ $mode='g';
+ $curfill='';
+# @mediabox=@defaultmb;
}
sub DrawBox
@@ -2902,6 +3528,7 @@ sub DrawBox
$res="$bg->[1] $bg->[2] $bg->[6] w\n";
$res.="$pg->[0] $bg->[4] $wid $dep re f " if $bg->[0] & 1;
$res.="$pg->[0] $bg->[4] $wid $dep re s " if $bg->[0] & 2;
+
return("$res\n");
}
@@ -2923,87 +3550,43 @@ sub do_f
{
my $par=shift;
my $fnt=$fontlst{$par}->{FNT};
+ $thisfnt=$fnt;
-# IsText();
+# IsText();
$cft="$par";
$fontchg=1;
-# $stream.="/F$cft $cftsz Tf\n" if $cftsz;
- $widtbl=CacheWid($par);
- $origwidtbl=[];
-
- foreach my $w (@{$fnt->{NO}})
- {
- push(@{$origwidtbl},$fnt->{NAM}->{$w->[1]}->[WIDTH]);
- }
-
-# $krntbl=$fnt->{KERN};
-}
-
-sub CacheWid
-{
- my $par=shift;
-
- if (!defined($fontlst{$par}->{CACHE}->{$cftsz}))
- {
- $fontlst{$par}->{CACHE}->{$cftsz}=BuildCache($fontlst{$par}->{FNT});
- }
-
- return($fontlst{$par}->{CACHE}->{$cftsz});
-}
-
-sub BuildCache
-{
- my $fnt=shift;
- my @cwid;
- $origwidtbl=[];
-
- foreach my $w (@{$fnt->{NO}})
- {
- my $wid=(defined($w) and
defined($w->[1]))?$fnt->{NAM}->{$w->[1]}->[WIDTH]:0;
- push(@cwid,$wid*$cftsz);
- push(@{$origwidtbl},$wid);
- }
-
- return(\@cwid);
+ PutLine();
}
sub IsText
{
if ($mode eq 'g')
{
- $xpos+=$pendmv/$unitwidth;
$stream.="q BT\n$matrix ".PutXY($xpos,$ypos)." Tm\n";
$poschg=0;
- $fontchg=0;
- $pendmv=0;
$matrixchg=0;
$tmxpos=$xpos;
$stream.=$textcol."\n", $curfill=$textcol if $textcol ne $curfill;
+
if (defined($cft))
{
- $whtsz=$fontlst{$cft}->{FNT}->{spacewidth}*$cftsz;
- $stream.="/F$cft $cftsz Tf\n";
+ $fontchg=1;
+# $stream.="/F$cft $cftsz Tf\n";
}
+
$stream.="$curkern Tc\n";
}
if ($poschg or $matrixchg)
{
PutLine(0) if $matrixchg;
+ shift(@lin) if $#lin==0 and !defined($lin[0]->[CHR]);
$stream.="$matrix ".PutXY($xpos,$ypos)." Tm\n", $poschg=0;
$tmxpos=$xpos;
$matrixchg=0;
$stream.="$curkern Tc\n";
}
- if ($fontchg)
- {
- PutLine(0);
- $whtsz=$fontlst{$cft}->{FNT}->{spacewidth}*$cftsz;
- $stream.="/F$cft $cftsz Tf\n" if $cftsz and defined($cft);
- $fontchg=0;
- }
-
$mode='t';
}
@@ -3013,9 +3596,6 @@ sub IsGraphic
{
PutLine();
$stream.="ET Q\n";
- $xpos+=($pendmv-$nomove)/$unitwidth;
- $pendmv=0;
- $nomove=0;
$stream.=$strkcol."\n", $curstrk=$strkcol if $strkcol ne $curstrk;
$curfill=$fillcol;
}
@@ -3027,14 +3607,14 @@ sub do_s
my $par=shift;
$par/=$unitwidth;
+ $whtsz=$fontlst{$cft}->{FNT}->{spacewidth}*$par if !defined($whtsz) and
defined($cft);
+
if ($par != $cftsz and defined($cft))
{
PutLine();
$cftsz=$par;
Set_LWidth() if $lwidth < 1;
-# $stream.="/F$cft $cftsz Tf\n";
$fontchg=1;
- $widtbl=CacheWid($cft);
}
else
{
@@ -3052,17 +3632,20 @@ sub Set_LWidth
sub do_m
{
- # Groff uses /m[] for text & graphic stroke, and /M[] (DF?) for graphic
fill.
- # PDF uses G/RG/K for graphic stroke, and g/rg/k for text & graphic fill.
+ # Groff uses /m[] for text & graphic stroke, and /M[] (DF?) for
+ # graphic fill. PDF uses G/RG/K for graphic stroke, and g/rg/k for
+ # text & graphic fill.
#
- # This means that we must maintain g/rg/k state separately for text colour
& graphic fill (this is
- # probably why 'gs' maintains separate graphic states for text & graphics
when distilling PS -> PDF).
+ # This means that we must maintain g/rg/k state separately for text
+ # colour & graphic fill (this is probably why 'gs' maintains
+ # separate graphic states for text & graphics when distilling PS ->
+ # PDF).
#
# To facilitate this:-
#
- # $textcol = current groff stroke colour
- # $fillcol = current groff fill colour
- # $curfill = current PDF fill colour
+ # $textcol = current groff stroke colour
+ # $fillcol = current groff fill colour
+ # $curfill = current PDF fill colour
my $par=shift;
my $mcmd=substr($par,0,1);
@@ -3070,7 +3653,7 @@ sub do_m
$par=substr($par,1);
$par=~s/^ +//;
-# IsGraphic();
+# IsGraphic();
$textcol=set_col($mcmd,$par,0);
$strkcol=set_col($mcmd,$par,1);
@@ -3133,8 +3716,6 @@ sub do_D
my $Dcmd=substr($par,0,1);
$par=substr($par,1);
- $xpos+=$pendmv/$unitwidth;
- $pendmv=0;
IsGraphic();
@@ -3225,6 +3806,7 @@ sub do_D
{
$stream.="f\n";
}
+
$poschg=1;
}
elsif ($Dcmd eq 'c')
@@ -3289,8 +3871,8 @@ sub do_D
my (@p)=split(' ',$par);
foreach my $p (@p) { $p/=$unitwidth; }
- # $xpos+=$p[0]*100; # WTF!!!
- #int lw = ((font::res/(72*font::sizescale))*linewidth*env->size)/1000;
+# $xpos+=$p[0]*100; # WTF!!!
+# int lw = ((font::res/(72*font::sizescale))*linewidth*env->size)/1000;
$p[0]=(($desc{res}/(72*$desc{sizescale}))*$linewidth*$cftsz)/1000 if
$p[0] < 0;
$lwidth=$p[0];
$stream.="$p[0] w\n";
@@ -3308,7 +3890,8 @@ sub do_D
foreach my $p (@p) { $p/=$unitwidth; }
- # Documentation is wrong. Groff does not use Dh1,Dv1 as centre of the
circle!
+ # Documentation is wrong. Groff does not use Dh1,Dv1 as centre
+ # of the circle!
my $centre=adjust_arc_centre(\@p);
@@ -3318,7 +3901,7 @@ sub do_D
my ($startang,$r)=RtoP(-$centre->[0],$centre->[1]);
my
($endang,$r2)=RtoP(($p[0]+$p[2])-$centre->[0],-($p[1]+$p[3]-$centre->[1]));
$endang+=$rad360 if $endang < $startang;
- my $totang=($endang-$startang)/4; # do it in 4 pieces
+ my $totang=($endang-$startang)/4; # do it in 4 pieces
# Now 1 piece
@@ -3363,7 +3946,7 @@ sub adjust_arc_centre
my $p=shift;
my @c;
- my $x = $p->[0] + $p->[2]; # (x, y) is the end point
+ my $x = $p->[0] + $p->[2]; # (x, y) is the end point
my $y = $p->[1] + $p->[3];
my $n = $x*$x + $y*$y;
if ($n != 0)
@@ -3409,8 +3992,6 @@ sub DrawCircle
my $kappa=0.5522847498;
$hd/=$unitwidth;
$vd/=$unitwidth;
-
-
$stream.=PutXY(($xpos+$hd),$ypos)." m\n";
$stream.=PutXY(($xpos+$hd),($ypos+$vr*$kappa))."
".PutXY(($xpos+$hr+$hr*$kappa),($ypos+$vr))."
".PutXY(($xpos+$hr),($ypos+$vr))." c\n";
$stream.=PutXY(($xpos+$hr-$hr*$kappa),($ypos+$vr))."
".PutXY(($xpos),($ypos+$vr*$kappa))." ".PutXY(($xpos),($ypos))." c\n";
@@ -3439,7 +4020,6 @@ sub FindCircle
{
return(-1);
}
-
}
sub PtoR
@@ -3458,126 +4038,120 @@ sub RtoP
sub PutLine
{
-
my $f=shift;
IsText() if !defined($f);
- return if (scalar(@lin) == 0) or (!defined($lin[0]->[0]) and $#lin == 0);
+ return if (scalar(@lin) == 0 or ($#lin == 0 and !defined($lin[0]->[CHR])));
-# $stream.="% --- wht=$whtsz, pend=$pendmv, nomv=$nomove\n" if $debug;
- $pendmv-=$nomove;
- $lin[$#lin]->[1]=-$pendmv/$cftsz if ($pendmv != 0);
+ my $s='[ ';
+ my $n=1;
+ my $len=0;
+ my $rev=0;
- foreach my $wd (@lin)
+ if (($lin[0]->[CHR]||0) < 0)
{
- next if !defined($wd->[0]);
- $wd->[0]=~s/\\/\\\\/g;
- $wd->[0]=~s/\(/\\(/g;
- $wd->[0]=~s/\)/\\)/g;
- $wd->[0]=~s/!\|!\|/\\/g;
- $wd->[1]=d3($wd->[1]);
+ $len=($lin[$#lin]->[XPOS]-$lin[0]->[XPOS]+$lin[$#lin]->[HWID])*100;
+ $s.=d3($len).' ';
+ $rev=1;
}
- if (0)
+ $stream.="%! wht0sz=".d3($whtsz/$unitwidth).",
wt=".((defined($wt))?d3($wt/$unitwidth):'--')."\n" if $debug;
+
+ foreach my $c (@lin)
{
- if (scalar(@lin) == 1 and (!defined($lin[0]->[1]) or $lin[0]->[1] == 0))
+ my $chr=$c->[CHR];
+ my $char;
+ my $chrc=defined($chr)?$c->[CHF]->[MAJOR].'/'.$chr:'';
+ $chrc.="(".chr(abs($chr)).")" if defined($chr) and $cftmajor==0 and
$chr<128;
+ $chrc.="[$c->[CHF]->[PSNAME]]" if defined($chr);
+
+ if (defined($chr))
{
- $stream.="($lin[0]->[0]) Tj\n";
+ $chr=abs($chr);
+ $char=chr($chr);
+ $char="\\\\" if $char eq "\\";
+ $char="\\(" if $char eq "(";
+ $char="\\)" if $char eq ")";
}
- else
- {
- $stream.="[";
- foreach my $wd (@lin)
- {
- $stream.="($wd->[0]) " if defined($wd->[0]);
- $stream.="$wd->[1] " if defined($wd->[1]) and $wd->[1] != 0;
- }
+ $stream.="%! PutLine: XPOS=$c->[XPOS], CHR=$chrc, CWID=$c->[CWID],
HWID=$c->[HWID], NOMV=$c->[NOMV]\n" if $debug;
- $stream.="] TJ\n";
- }
- }
- else
- {
- if (scalar(@lin) == 1 and (!defined($lin[0]->[1]) or $lin[0]->[1] == 0))
- {
- $stream.="0 Tw ($lin[0]->[0]) Tj\n";
- }
- else
+ if (!defined($chr) and defined($wt))
{
- if ($wt>=-1 or $#lin == 0 or $lin[0]->[1]>=0)
- {
- $stream.="0 Tw [";
+ # white space
- foreach my $wd (@lin)
- {
- $stream.="($wd->[0]) " if defined($wd->[0]);
- $stream.="$wd->[1] " if defined($wd->[1]) and $wd->[1] != 0;
- }
+ my $gap = $c->[HWID]*$unitwidth;
- $stream.="] TJ\n";
- }
- else
+ if ($options & USESPACE and $thisfnt->{nospace}==0)
{
- # $stream.="\%dg 0 Tw [";
- #
- # foreach my $wd (@lin)
- # {
- # $stream.="($wd->[0]) " if defined($wd->[0]);
- # $stream.="$wd->[1] " if defined($wd->[1]) and
$wd->[1] != 0;
- # }
- #
- # $stream.="] TJ\n";
- #
- # my $wt=$lin[0]->[1]||0;
+ $stream.="%!! GAP=".($gap)."\n" if $debug;
- # while ($wt < -$whtsz/$cftsz)
- # {
- # $wt+=$whtsz/$cftsz;
- # }
-
- $stream.=sprintf( "%.3f Tw
",-($whtsz+$wt*$cftsz)/$unitwidth-$curkern );
- if (!defined($lin[0]->[0]) and defined($lin[0]->[1]))
+# while ($gap >= $whtsz+$wt)
+# while (abs($gap - ($whtsz+$wt)) > 1)
+ if ($wt >= 0)
{
- $stream.="[ $lin[0]->[1] (";
- shift @lin;
+ my $i=int(($gap+1) / ($whtsz+$wt));
+
+ if ($i < 6)
+ {
+ $s.="(",$n=0 if $n;
+ $s.=' ' x $i;
+ $gap-=($whtsz+$wt) * $i;
+ }
}
else
{
- $stream.="[(";
+ $wt=0;
}
+ }
- foreach my $wd (@lin)
- {
- my $wwt=$wd->[1]||0;
+ if (abs($gap) > 1)
+ {
+ $s.=') ' if !$n;
+ $s.=d3(-$gap/$cftsz).' (';
+ $n=0;
+ }
+ }
+ elsif ($c->[CWID] != $c->[HWID])
+ {
+ if ($rev)
+ {
+ $s.=') ' if !$n;
+ $s.=d3(($c->[CWID]-$c->[HWID])*100).' (';
+ $n=0;
+ }
- while ($wwt <= $wt+.1)
- {
- $wwt-=$wt;
- $wd->[0].=' ';
- }
+ if (defined($chr))
+ {
+ $s.=' (',$n=0 if $n;
+ $s.=$char;
+ }
- if (abs($wwt) < .1 or $wwt == 0)
- {
- $stream.="$wd->[0]" if defined($wd->[0]);
- }
- else
- {
- $wwt=sprintf("%.3f",$wwt);
- $stream.="$wd->[0]) $wwt (" if defined($wd->[0]);
- }
- }
- $stream.=")] TJ\n";
+ if (!$rev)
+ {
+ $s.=') ' if !$n;
+ $s.=d3((($c->[CWID]-$c->[HWID])*1000)/$cftsz).' (';
+ $n=0;
}
+
+ }
+ else
+ {
+ $s.="(",$n=0 if $n;
+ $s.=$char;
}
}
+ $s=substr($s,0,-1),$n=1 if substr($s,-1) eq "(" and substr($s,-2,1) ne
"\\";
+ $s.=")" if !$n;
+ $s.=d3(-$len) if $len;
+ $wt=0 if !defined($wt);
+ $stream.=d3($wt/$unitwidth)." Tw ";
+ $stream.="$s] TJ\n";
@lin=();
- $xpos+=$pendmv/$unitwidth;
- $pendmv=0;
- $nomove=0;
- $wt=-1;
+ $wt=undef;
+ $whtsz=$fontlst{$cft}->{FNT}->{spacewidth}*$cftsz;
}
sub d3
@@ -3585,7 +4159,7 @@ sub d3
return(sprintf("%.3f",shift || 0));
}
-sub LoadAhead
+sub LoadAhead
{
my $no=shift;
@@ -3609,25 +4183,9 @@ sub do_V
{
PutLine();
}
- else
- {
- $xpos+=$pendmv/$unitwidth;
- $pendmv=0;
- }
$ypos=$par/$unitwidth;
- LoadAhead(1);
-
- if (substr($ahead[0],0,1) eq 'H')
- {
- $xpos=substr($ahead[0],1)/$unitwidth;
-
- $nomove=$pendmv=0;
- @ahead=();
-
- }
-
$poschg=1;
}
@@ -3642,74 +4200,50 @@ sub do_v
$poschg=1;
}
-sub TextWid
+sub GetNAM
{
- my $txt=shift;
- my $fnt=shift;
- my $w=0;
- my $ck=0;
-
- foreach my $c (split('',$txt))
- {
- my $cn=ord($c);
- $widtbl->[$cn]=$origwidtbl->[$cn]*$cftsz if !defined($widtbl->[$cn]);
- $w+=$widtbl->[$cn];
- }
+ my ($f,$c)=(@_);
- $ck=length($txt)*$curkern;
-
- return(($w/$unitwidth)+$ck);
+ my $r=$f->{NAM}->{$c};
+ return($r,$c) if ref($r) eq 'ARRAY';
+ return($f->{NAM}->{$r},$r);
}
-sub do_t
+sub AssignGlyph
{
- my $par=shift;
- my $fnt=$fontlst{$cft}->{FNT};
+ my ($fnt,$chf,$ch)=(@_);
- if ($kernadjust != $curkern)
+ if ($chf->[CHRCODE] > 32 and $chf->[CHRCODE] < 128)
{
- PutLine();
- $stream.="$kernadjust Tc\n";
- $curkern=$kernadjust;
+ ($chf->[MINOR],$chf->[MAJOR])=($chf->[CHRCODE],0);
}
-
- my $par2=$par;
- $par2=~s/^!\|!\|(\d\d\d)/chr(oct($1))/e;
-
- foreach my $j (0..length($par2)-1)
+ elsif ($chf->[CHRCODE] == 173)
+ {
+ ($chf->[MINOR],$chf->[MAJOR])=(31,0);
+ }
+ else
{
- my $cn=ord(substr($par2,$j,1));
- my $chnm=$fnt->{NAM}->{$fnt->{NO}->[$cn]->[1]};
+ ($chf->[MINOR],$chf->[MAJOR])=NextAlloc($fnt);
+ }
- if ($chnm->[USED]==0)
- {
- $chnm->[USED]=1;
- }
- elsif ($fnt->{NO}->[$cn]->[0] ne $fnt->{NO}->[$cn]->[1])
- {
- # A glyph has already been remapped to this char, so find a spare
+# $fnt->{SUB}->[$chf->[MAJOR]]->{CHARSET}.=$chf->[PSNAME];
- my $cn2=RemapChr($cn,$fnt,$fnt->{NO}->[$cn]->[0]);
- $stream.="% MMM Remap $cn to $cn2\n" if $debug;
+ my $uc;
- if ($cn2)
- {
- substr($par2,$j,1)=chr($cn2);
+ # Add ToUnicode CMap entry - requires change to afmtodit
- if ($par=~m/^!\|!\|(\d\d\d)/)
- {
- substr($par,4,3)=sprintf("%03o",$cn2);
- }
- else
- {
- substr($par,$j,1)=chr($cn2);
- }
- }
- }
- }
- my $wid=TextWid($par2,$fnt);
+ push(@{$fnt->{CHARSET}->[$chf->[MAJOR]]},$chf->[PSNAME]);
+ push(@{$fnt->{TRFCHAR}->[$chf->[MAJOR]]},$ch);
+ $stream.="% Assign: $chf->[PSNAME] to $chf->[MAJOR]/$chf->[MINOR]\n" if
$debug;
+}
+
+sub PutGlyph
+{
+ my ($fnt,$ch,$nowidth)=@_;
+ my $chf;
+ ($chf,$ch)=GetNAM($fnt,$ch);
- $par=reverse(split('',$par)) if $xrev and $par!~m/^!\|!\|(\d\d\d)/;
+ IsText();
if ($n_flg and defined($mark))
{
@@ -3718,81 +4252,90 @@ sub do_t
}
$n_flg=0;
- IsText();
- $xpos+=$wid;
- $xpos+=($pendmv-$nomove)/$unitwidth;
-
- $stream.="% == '$par'=$wid 'xpos=$xpos\n" if $debug;
-
- # $pendmv = 'h' move since last 't'
- # $nomove = width of char(s) added by 'C', 'N' or 'c'
- # $w-flg = 'w' seen since last t
+ if (!defined($chf->[MINOR]))
+ {
+ AssignGlyph($fnt,$chf,$ch);
+ }
- if ($fontchg)
+ if ($fontchg or $chf->[MAJOR] != $cftmajor)
{
PutLine();
- $whtsz=$fontlst{$cft}->{FNT}->{spacewidth}*$cftsz;
- $stream.="/F$cft $cftsz Tf\n", $fontchg=0 if $fontchg && defined($cft);
+ $cftmajor=$chf->[MAJOR];
+# $whtsz=$fontlst{$cft}->{FNT}->{spacewidth}*$cftsz;
+ my $c=$cft;
+ $c.=".".$cftmajor if $cftmajor;
+ $stream.="/F$c $cftsz Tf\n";
+ $fontchg=0;
}
- $gotT=1;
-
- $stream.="% --- wht=$whtsz, pend=$pendmv, nomv=$nomove\n" if $debug;
-
-# if ($w_flg && $#lin > -1)
-# {
-# $lin[$#lin]->[0].=' ';
-# $pendmv-=$whtsz;
-# $dontglue=1 if $pendmv==0;
-# }
+ my $cn=$chf->[MINOR];
+ my $chr=chr($cn);
+ my $cwid=($chf->[WIDTH]*$cftsz)/$unitwidth+$curkern;
+ my $hwid=($nowidth)?0:$cwid;
- $wt=-$pendmv/$cftsz if $w_flg and $wt==-1;
- $pendmv-=$nomove;
- $nomove=0;
- $w_flg=0;
+ $gotT=1;
if ($xrev)
{
- PutLine(0) if $#lin > -1;
- MakeMatrix(1);
- $stream.="$matrix ".PutXY($xpos,$ypos)." Tm\n", $poschg=0;
- $stream.="$curkern Tc\n";
- $stream.="0 Tw ";
- $stream.="($par) Tj\n";
- MakeMatrix();
- $stream.="$matrix ".PutXY($xpos,$ypos)." Tm\n", $poschg=0;
- $matrixchg=0;
- $stream.="$curkern Tc\n";
- return;
+ PutLine(0) if $#lin > -1 and ($lin[$#lin]->[CHR]||0) > 0;
+ $cn=-$cn;
+ }
+ else
+ {
+ PutLine(0) if $#lin > -1 and ($lin[$#lin]->[CHR]||0) < 0;
}
- if ($pendmv)
+ if ($#lin < 1)
{
- if ($#lin == -1)
+ if (!$inxrev and $cn < 0) # in xrev
{
- push(@lin,[undef,-$pendmv/$cftsz]);
+ MakeMatrix(1);
+ $inxrev=1;
}
- else
+ elsif ($inxrev and $cn > 0)
{
- $lin[$#lin]->[1]=-$pendmv/$cftsz;
+ MakeMatrix(0);
+ $inxrev=0;
}
- push(@lin,[$par,undef]);
-# $xpos+=$pendmv/$unitwidth;
- $pendmv=0
- }
- else
- {
- if ($#lin == -1)
+ if ($matrixchg or $poschg)
{
- push(@lin,[$par,undef]);
- }
- else
- {
- $lin[$#lin]->[0].=$par;
+ $stream.="$matrix ".PutXY($xpos,$ypos)." Tm\n", $poschg=0;
+ $tmxpos=$xpos;
+ $matrixchg=0;
+ $stream.="$curkern Tc\n";
}
}
+
+ $whtsz=$fontlst{$cft}->{FNT}->{spacewidth}*$cftsz if $#lin==-1;
+# $stream.="%!!! Put: font=$cft, char=$chf->[PSNAME]\n" if $debug;
+
+ push(@lin,[$cn,$xpos,$cwid,$hwid,$nowidth,$chf]);
+
+ $xpos+=$hwid;
+}
+
+sub do_t
+{
+ my $par=shift;
+ my $fnt=$fontlst{$cft}->{FNT};
+
+ if ($kernadjust != $curkern)
+ {
+ PutLine();
+ $stream.="$kernadjust Tc\n";
+ $curkern=$kernadjust;
+ }
+
+ IsText();
+
+ foreach my $j (0..length($par)-1)
+ {
+ my $ch=substr($par,$j,1);
+
+ PutGlyph($fnt,$ch,0);
+ }
}
sub do_u
@@ -3807,137 +4350,605 @@ sub do_u
sub do_h
{
- $pendmv+=shift;
+ my $v=shift;
+
+ $v/=$unitwidth;
+
+ if ($mode eq 't')
+ {
+ if ($w_flg)
+ {
+ if ($#lin > -1 and $lin[$#lin]->[NOMV]==1)
+ {
+ $lin[$#lin]->[HWID]=$v;
+ }
+ else
+ {
+ push(@lin,[undef,$xpos,$v,$v,0]);
+ }
+
+ if (!defined($wt))
+ {
+ $whtsz=$fontlst{$cft}->{FNT}->{spacewidth}*$cftsz;
+ $wt=($v * $unitwidth) - $whtsz;
+ $stream.="%!! wt=$wt, whtsz=$whtsz\n" if $debug;
+ }
+
+ $w_flg=0;
+ }
+ else
+ {
+ if ($#lin > -1 and $lin[$#lin]->[NOMV]==1)
+ {
+ $lin[$#lin]->[HWID]=$v;
+ }
+ else
+ {
+ push(@lin,[undef,$xpos,0,$v,0]);
+ }
+ }
+ }
+
+ $xpos+=$v;
}
sub do_H
{
my $par=shift;
+ $xpos=($par/$unitwidth);
if ($mode eq 't')
{
- PutLine();
- }
- else
- {
- $xpos+=$pendmv/$unitwidth;
- $pendmv=0;
+# PutLine();
+ if ($#lin > -1)
+ {
+ $lin[$#lin]->[HWID]=d3($xpos-$lin[$#lin]->[XPOS]);
+ }
+ else
+ {
+ $stream.=d3($xpos-$tmxpos)." 0 Td\n" if $mode eq 't';
+ $tmxpos=$xpos;
+ }
}
-
- my $newx=$par/$unitwidth;
- $stream.=sprintf("%.3f",$newx-$tmxpos)." 0 Td\n" if $mode eq 't';
- $tmxpos=$xpos=$newx;
- $pendmv=$nomove=0;
}
sub do_C
{
my $par=shift;
+ my $fnt=$fontlst{$cft}->{FNT};
- my ($par2,$nm)=FindChar($par);
+ PutGlyph($fnt,$par,1);
+}
+
+sub do_c
+{
+ my $par=shift;
- do_t($par2);
- $nomove=$fontlst{$cft}->{FNT}->{NAM}->{$par}->[WIDTH]*$cftsz ;
+ push(@ahead,substr($par,1));
+ $par=substr($par,0,1);
+ do_C($par);
}
-sub FindChar
+sub do_N
{
- my $chnm=shift;
+ my $par=shift;
my $fnt=$fontlst{$cft}->{FNT};
- if (exists($fnt->{NAM}->{$chnm}))
+ if (!defined($fnt->{NO}->[$par]))
+ {
+ Warn("no chr($par) in font $fnt->{internalname}");
+ return;
+ }
+
+ my $chnm=$fnt->{NO}->[$par];
+ PutGlyph($fnt,$chnm,1);
+}
+
+sub do_n
+{
+ $gotT=0;
+ PutLine(0);
+ $n_flg=1;
+ @lin=();
+ PutHotSpot($xpos) if defined($mark);
+}
+
+sub NextAlloc
+{
+ my $fnt=shift;
+
+ $alloc=++$fnt->{ALLOC};
+
+ my $maj=$alloc >> 8;
+ my $min=$alloc & 0xff;
+
+ my $start=($maj == 0)?128:33;
+ $min=$start if $min < $start;
+ $min++ if $min == ord('(');
+ $min++ if $min == ord(')');
+ $maj++,$min=$start if $min > 255;
+
+ $fnt->{ALLOC}=($maj << 8) + $min;
+
+ return($min,$maj);
+}
+
+sub decrypt_char
+{
+ my $l=shift;
+ my (@la)=unpack('C*',$l);
+ my @res;
+
+ if ($lenIV >= 0)
{
- my $ch=$fnt->{NAM}->{$chnm}->[ASSIGNED];
- $ch=RemapChr($ch,$fnt,$chnm) if ($ch > 255);
- $fnt->{NAM}->{$chnm}->[USED]=0 if $fnt->{NO}->[$ch]->[1] eq $chnm;
+ my $clr;
+ my $cr=C_DEF;
+ my $skip=$lenIV;
+
+ foreach my $cypher (@la)
+ {
+ $clr=($cypher ^ ($cr >> 8)) & 0xFF;
+ $cr=(($cypher + $cr) * MAGIC1 + MAGIC2) & 0xFFFF;
+ push(@res,$clr) if --$skip < 0;
+ }
- return(($ch<32)?sprintf("!|!|%03o",$ch):chr($ch),$widtbl->[$ch]);
+ return(\@res);
}
else
{
- return(' ');
+ return(\@la);
}
}
-sub RemapChr
+sub decrypt_exec_P
{
- my $ch=shift;
- my $fnt=shift;
- my $chnm=shift;
- my $unused=0;
+ my $e=shift;
+ my $l=shift;
+ $l--;
+ my $clr;
+ my $er=E_DEF;
+
+ foreach my $j (0..$l)
+ {
+ my $cypher=ord(substr($$e,$j,1));
+ $clr=($cypher ^ ($er >> 8)) & 0xFF;
+ $er=(($cypher + $er) * MAGIC1 + MAGIC2) & 0xFFFF;
+ substr($$e,$j,1)=chr($clr);
+ }
+
+ return($e);
+}
+
+sub encrypt_exec
+{
+ my $la=shift;
+ unshift(@{$la},0x44,0x65,0x72,0x69);
+ my $res;
+ my $cypher;
+ my $er=E_DEF;
+
+ foreach my $clr (@{$la})
+ {
+ $cypher=($clr ^ ($er >> 8)) & 0xFF;
+ $er=(($cypher + $er) * MAGIC1 + MAGIC2) & 0xFFFF;
+ $res.=pack('C',$cypher);
+ }
+
+ return($res);
+}
+
+sub encrypt_char
+{
+ my $la=shift;
+ unshift(@{$la},0x44,0x65,0x72,0x69);
+ my $res;
+ my $cypher;
+ my $cr=C_DEF;
+
+ foreach my $clr (@{$la})
+ {
+ $cypher=($clr ^ ($cr >> 8)) & 0xFF;
+ $cr=(($cypher + $cr) * MAGIC1 + MAGIC2) & 0xFFFF;
+ $res.=pack('C',$cypher);
+ }
+
+ return($res);
+}
+
+sub map_subrs
+{
+ my $lines=shift;
+ my $stage=0;
+ my $lin=$lines->[0];
+ my $i=0;
+
+ for (my $j=0; $j<=$#{$lines}; $lin=$lines->[++$j] )
+ {
+# next if !defined($lines->[$j]);
+
+ if ($stage == 0)
+ {
+ if ($lin=~m/^\s*\/Subrs \d+/)
+ {
+ $sec{'#Subrs'}=$j;
+ $stage=1;
+ }
+ }
+ elsif ($stage == 1)
+ {
+ if ($lin=~m/^\s*\d index \/CharStrings \d+/)
+ {
+ $sec{'#CharStrings'}=$j;
+ $stage=2;
+ $i=0;
+ }
+ elsif ($lin=~m/^\s*dup\s+(\d+)\s+(\d+)\s+RD (.*)/s)
+ {
+ my $n=$1;
+ my $l=$2;
+ my $s=$3;
+
+ if (!exists($sec{"#$n"}))
+ {
+ $sec{"#$n"}=[$j,{}];
+ $i=$j;
+ $sec{"#$n"}->[NEWNO]=$n if $n<=$newsub;
+ }
+
+ if (length($s) > $l)
+ {
+ $s=substr($s,0,$l);
+ }
+ else
+ {
+ $lin.=$term.$lines->[++$j];
+ $lines->[$j]=undef;
+ redo;
+ }
+
+# $s=decrypt_char($s);
+# subs_call($s,"#$n");
+ $lines->[$i]=["#$n",$l,$s,'NP'];
+ }
+ elsif ($lin=~m/^ND/)
+ {}
+ else
+ {
+ Warn("Don't understand '$lin'");
+ }
+ }
+ elsif ($stage == 2)
+ {
+ if ($lin=~m/^0{64}/)
+ {
+ $sec{'#Pad'}=$j;
+ $stage=3;
+ }
+ elsif ($lin=~m/^\s*\/([-.\w]*)\s+(\d+)\s+RD (.*)/s)
+ {
+ my $n=$1;
+ my $l=$2;
+ my $s=$3;
- foreach my $un (0..$#{$fnt->{NO}})
+ $sec{"/$n"}=[$j,{}] if !exists($sec{"/$n"});
+
+ if (length($s) > $l)
+ {
+ $s=substr($s,0,$l);
+ }
+ else
+ {
+ $lin.=$term.$lines->[++$j];
+ $lines->[$j]=undef;
+ $i--;
+ redo;
+ }
+
+ $i+=$j;
+
+ if ($sec{"/$n"}->[0] != $i)
+ {
+ # duplicate glyph name !!! discard ???
+ $lines->[$i]=undef;
+ }
+ else
+ {
+ $lines->[$i]=["/$n",$l,$s,'ND'];
+ }
+
+ $i=0;
+ }
+# else
+# {
+# Warn("Don't understand '$lin'");
+# }
+ }
+ elsif ($stage == 3)
+ {
+ if ($lin=~m/cleartomark/)
+ {
+ $sec{'#cleartomark'}=[$j];
+ $stage=4;
+ }
+ elsif ($lin!~m/^0+$/)
+ {
+ Warn("Expecting padding - got '$lin'");
+ }
+ }
+ }
+}
+
+sub subs_call
+{
+ my $charstr=shift;
+ my $key=shift;
+ my $lines=shift;
+ my @c;
+
+ for (my $j=0; $j<=$#{$charstr}; $j++)
{
- next if $un >= 139 and $un <= 144;
- $unused=$un,last if $fnt->{NO}->[$un]->[1] eq '';
+ my $n=$charstr->[$j];
+
+ if ($n >= 32 and $n <= 246)
+ {
+ push(@c,[$n-139,1]);
+ }
+ elsif ($n >= 247 and $n <= 250)
+ {
+ push(@c,[(($n-247) << 8)+$charstr->[++$j]+108,1]);
+ }
+ elsif ($n >= 251 and $n <= 254)
+ {
+ push(@c,[-(($n-251) << 8)-$charstr->[++$j]-108,1]);
+ }
+ elsif ($n == 255)
+ {
+ $n=($charstr->[++$j] << 24)+($charstr->[++$j] <<
16)+($charstr->[++$j] << 8)+$charstr->[++$j];
+ $n=~$n if $n & 0x8000;
+ push(@c,[$n,1]);
+ }
+ elsif ($n == 10)
+ {
+ if ($c[$#c]->[1])
+ {
+ $c[$#c]->[0]=MarkSub("#$c[$#c]->[0]");
+ $c[$#c-1]->[0]=MarkSub("#$c[$#c-1]->[0]") if ($c[$#c]->[0] == 4
and $c[$#c-1]->[1]);
+ }
+ push(@c,[10,0]);
+ }
+ elsif ($n == 12)
+ {
+ push(@c,[12,0]);
+ my $n2=$charstr->[++$j];
+ push(@c,[$n2,0]);
+
+ if ($n2==6) # seac
+ {
+ my $ch=$StdEnc{$c[$#c-2]->[0]};
+ my $chf;
+
+ # if ($ch ne 'space')
+ {
+ ($chf)=GetNAM($thisfnt,$ch);
+
+ if (!defined($chf->[MINOR]))
+ {
+ AssignGlyph($thisfnt,$chf,$ch);
+ Subset($lines,"$chf->[PSNAME]");
+ push(@{$seac{$key}},"$ch");
+ }
+ }
+
+ $ch=$StdEnc{$c[$#c-3]->[0]};
+
+ if ($ch ne 'space')
+ {
+ ($chf)=GetNAM($thisfnt,$ch);
+
+ if (!defined($chf->[MINOR]))
+ {
+ AssignGlyph($thisfnt,$chf,$ch);
+ Subset($lines,"$chf->[PSNAME]");
+ push(@{$seac{$key}},"$ch");
+ }
+ }
+ }
+ }
+ else
+ {
+ push(@c,[$n,0]);
+ }
}
- if (!$unused)
+ $sec{$key}->[CHARCHAR]=\@c;
+
+# foreach my $j (@c) {Warn("Undefined op in $key") if !defined($j);}
+}
+
+sub Subset
+{
+ my $lines=shift;
+ my $glyphs=shift;
+ my $extra=shift;
+
+ foreach my $g ($glyphs=~m/(\/[.\w]+)/g)
{
- foreach my $un (128..255)
+ if (exists($sec{$g}))
+ {
+ $glyphseen{$g}=1;
+ $g='/space' if $g eq '/ ';
+
+ my $ln=$lines->[$sec{$g}->[LINE]];
+ subs_call($sec{$g}->[CHARCHAR]=decrypt_char($ln->[STR]),$g,$lines);
+
+ push(@glyphused,$g);
+ }
+ else
{
- next if $un >= 139 and $un <= 144;
- my $glyph=$fnt->{NO}->[$un]->[1];
- $unused=$un,last if $fnt->{NAM}->{$glyph}->[USED] == 0;
+ Warn("Can't locate glyph '$g' in font") if $g ne '/space';
}
}
+}
- if ($unused && $unused <= 255)
+sub MarkSub
+{
+ my $k=shift;
+
+ if (exists($sec{$k}))
{
- my $glyph=$fnt->{NO}->[$unused]->[1];
- delete($fontlst{$cft}->{CACHE}->{$cftsz});
- $fnt->{NAM}->{$chnm}->[ASSIGNED]=$unused;
- $fnt->{NAM}->{$chnm}->[USED]=1;
- $fnt->{NO}->[$unused]->[1]=$chnm;
- $widtbl=CacheWid($cft);
+ if (!defined($sec{$k}->[NEWNO]))
+ {
+ $sec{$k}->[NEWNO]=++$newsub;
+ push(@subrused,$k);
- $stream.="% AAA Assign $chnm ($ch) to $unused\n" if $debug;
+ my $ln=$bl[$sec{$k}->[LINE]];
+ subs_call($sec{$k}->[CHARCHAR]=decrypt_char($ln->[STR]),$k,\@bl);
+ }
- $ch=$unused;
- return($ch);
+ return($sec{$k}->[NEWNO]);
}
else
{
- Warn("too many glyphs used in font '$cft'");
- return(32);
+ Log(1,"Missing Subrs '$k'");
}
}
-sub do_c
+sub encrypt
{
- my $par=shift;
+ my $lines=shift;
- push(@ahead,substr($par,1));
- $par=substr($par,0,1);
- my $ch=ord($par);
- do_N($ch);
+ if (exists($sec{'#Subrs'}))
+ {
+ $newsub++;
+ $lines->[$sec{'#Subrs'}]=~s/\d+\s+array/$newsub array/;
+ }
+ else
+ {
+ Warn("Unable to locate /Subrs");
+ }
+
+ if (exists($sec{'#CharStrings'}))
+ {
+ my $n=$#glyphused+1;
+ $lines->[$sec{'#CharStrings'}]=~s/\d+\s+dict /$n dict /;
+ }
+ else
+ {
+ Warn("Unable to locate /CharStrings");
+ }
+
+ my $bdy;
+
+ for (my $j=0; $j<=$#{$lines}; $j++)
+ {
+ my $lin=$lines->[$j];
+
+ next if !defined($lin);
+
+ if (ref($lin) eq 'ARRAY' and $lin->[TYPE] eq 'NP')
+ {
+ foreach my $sub (@subrused)
+ {
+ if (exists($sec{$sub}))
+ {
+
subs_call($sec{$sub}->[CHARCHAR]=decrypt_char($lines->[$sec{$sub}->[LINE]]->[STR]),$sub,$lines)
if (!defined($sec{$sub}->[CHARCHAR]));
+ my $cs=encode_charstr($sec{$sub}->[CHARCHAR],$sub);
+ $bdy.="dup ".$sec{$sub}->[NEWNO].' '.length($cs)." RD $cs
NP\n";
+ }
+ else
+ {
+ Warn("Failed to locate Subr '$sub'");
+ }
+ }
+
+ while (!defined($lines->[$j+1]) or ref($lines->[$j+1]) eq 'ARRAY')
{$j++;};
+ }
+ elsif (ref($lin) eq 'ARRAY' and $lin->[TYPE] eq 'ND')
+ {
+ foreach my $chr (@glyphused)
+ {
+ if (exists($sec{$chr}))
+ {
+ my $cs=encode_charstr($sec{$chr}->[CHARCHAR],$chr);
+ $bdy.="$chr ".length($cs)." RD $cs ND\n";
+ }
+ else
+ {
+ Warn("Failed to locate glyph '$chr'");
+ }
+ }
+
+ while (!defined($lines->[$j+1]) or ref($lines->[$j+1]) eq 'ARRAY')
{$j++;};
+ }
+ else
+ {
+ $bdy.="$lin\n";
+ }
+ }
+
+ my @bdy=unpack('C*',$bdy);
+ return(encrypt_exec(\@bdy));
}
-sub do_N
+sub encode_charstr
{
- my $par=shift;
- my $fnt=$fontlst{$cft}->{FNT};
+ my $ops=shift;
+ my $key=shift;
+ my @c;
- if (!defined($fnt->{NO}->[$par]))
+ foreach my $c (@{$ops})
{
- Warn("no chr($par) in font $fnt->{internalname}");
- return;
+ my $n=$c->[0];
+ my $num=$c->[1];
+
+ if ($num)
+ {
+ if ($n >= -107 and $n <= 107)
+ {
+ push(@c,$n+139);
+ }
+ elsif ($n >= 108 and $n <= 1131)
+ {
+ my $hi=($n - 108)>>8;
+ my $lo=($n - 108) & 0xff;
+ push(@c,$hi+247,$lo);
+ }
+ elsif ($n <= -108 and $n >= -1131)
+ {
+ my $hi=abs($n + 108)>>8;
+ my $lo=abs($n + 108) & 0xff;
+ push(@c,$hi+251,$lo);
+ }
+# elsif ($n >= -32768 and $n <= 32767)
+# {
+# push(@c,28,($n>>8) & 0xff,$n & 0xff);
+# }
+ else
+ {
+ push(@c,255,($n >> 24) & 0xff, ($n >> 16) & 0xff,
+ ($n >> 8) & 0xff, $n & 0xff );
+ }
+ }
+ else
+ {
+ push(@c, $n);
+ }
}
- my $chnm=$fnt->{NO}->[$par]->[0];
- do_C($chnm);
+ return(encrypt_char(\@c));
}
-sub do_n
+sub SubTag
{
- $gotT=0;
- PutLine(0);
- $pendmv=$nomove=0;
- $n_flg=1;
- @lin=();
- PutHotSpot($xpos) if defined($mark);
-}
+ my $res;
+ foreach (1..6)
+ {
+ $res.=chr(int((rand(26)))+65);
+ }
+
+ return($res.'+');
+}
1;
# Local Variables:
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [groff] 14/18: [gropdf]: Add font subsetting and Type 1 parser.,
G. Branden Robinson <=