diff --git a/src/devices/gropdf/gropdf.pl b/src/devices/gropdf/gropdf.pl index f0b04909a..e26bc6b43 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-2024 Free Software Foundation, Inc. +# Copyright (C) 2011-2020 Free Software Foundation, Inc. # Written by Deri James # # This file is part of groff. @@ -26,7 +26,6 @@ require 5.8.0; use Getopt::Long qw(:config bundling); use Encode qw(encode); use POSIX qw(mktime); -use File::Spec qw(splitpath); use constant { @@ -36,6 +35,8 @@ use constant MINOR => 3, MAJOR => 4, UNICODE => 5, + RST => 6, + RSB => 7, CHR => 0, XPOS => 1, @@ -48,7 +49,6 @@ use constant MAGIC2 => 22719, C_DEF => 4330, E_DEF => 55665, - LINE => 0, CALLS => 1, NEWNO => 2, @@ -63,6 +63,7 @@ use constant USESPACE => 2, COMPRESS => 4, NOFILE => 8, + }; my %StdEnc=( @@ -217,8 +218,7 @@ my %StdEnc=( 251 => 'ss', ); -(undef,undef,my $prog)=File::Spec->splitpath($0); - +my $prog=$0; unshift(@ARGV,split(' ',$ENV{GROPDF_OPTIONS})) if exists($ENV{GROPDF_OPTIONS}); my $gotzlib=0; @@ -352,6 +352,7 @@ 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 @@ -362,7 +363,7 @@ my @XOstream=(); my @PageAnnots={}; my $noslide=0; my $transition={PAGE => {Type => '/Trans', S => '', D => 1, Dm => '/H', M => '/I', Di => 0, SS => 1.0, B => 0}, - BLOCK => {Type => '/Trans', S => '', D => 1, Dm => '/H', M => '/I', Di => 0, SS => 1.0, B => 0}}; +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 @@ -431,15 +432,15 @@ sub usage my $had_error = shift; $stream = *STDERR if $had_error; print $stream -"usage: $prog [-dels] [-F font-directory] [-I inclusion-directory]" . -" [-p paper-format] [-u [cmap-file]] [-y foundry] [file ...]\n" . -"usage: $prog {-v | --version}\n" . -"usage: $prog --help\n"; + "usage: $prog [-dels] [-F font-directory] [-I inclusion-directory]" . + " [-p paper-format] [-u [cmap-file]] [-y foundry] [file ...]\n" . + "usage: $prog {-v | --version}\n" . + "usage: $prog --help\n"; if (!$had_error) { print $stream "\n" . -"Translate the output of troff(1) into Portable Document Format.\n" . -"See the gropdf(1) manual page.\n"; + "Translate the output of troff(1) into Portable Document Format.\n" . + "See the gropdf(1) manual page.\n"; } exit($had_error); } @@ -565,8 +566,7 @@ for $papersz ( split(" ", lc($possiblesizes).' #duff#') ) } } - # 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)); @@ -629,7 +629,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'); @@ -652,6 +652,7 @@ while (<>) my $tmp=scalar(@ahead); }} until scalar(@ahead) == 0; + } exit 0 if $lct==0; @@ -824,6 +825,7 @@ foreach my $fontno (sort keys %fontlst) 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})) @@ -855,6 +857,7 @@ foreach my $fontno (sort keys %fontlst) } } } + } foreach my $j (0..$#{$pages->{Kids}}) @@ -989,6 +992,7 @@ else print "startxref\n$xrefct\n\%\%EOF\n"; print "\% Pages=$pages->{Count}\n" if $stats; + sub MakeMatrix { my $fontxrev=shift||0; @@ -1097,6 +1101,8 @@ sub GetObj return($obj[$ono]->{DATA}); } + + sub PDFDate { my $dt=shift; @@ -1541,7 +1547,7 @@ sub do_x $curoutlevno=$#{$curoutlev}; } -# push(@{$curoutlev},$this); + # push(@{$curoutlev},$this); splice(@{$curoutlev},++$curoutlevno,0,$this); $curoutlev->[0]->[2]++; } @@ -1802,7 +1808,7 @@ sub do_x else { ($curoutlev,$curoutlevno,$thislev)=(@{$outlines[$pginsert]}); -# $curoutlevno--; + $curoutlevno--; } } } @@ -1837,7 +1843,7 @@ sub do_x { splice(@xprm,0,2); my $type=shift(@xprm); -# print STDERR "ypos=$ypos\n"; + # print STDERR "ypos=$ypos\n"; if (lc($type) eq 'off') { @@ -2002,7 +2008,6 @@ sub Clean sub utf16 { my $p=Clean(shift); - my $label=shift; $p=~s/\\\[(.*?)\]/FindChr($1,0)/eg; $p=~s/\\C($parcln)/FindChr($1,1)/eg; @@ -2015,8 +2020,6 @@ sub utf16 unpack "C*", encode('utf16', $p); } - return($p) if $label; - $p=~s/(?[$curobj]->{OBJ}=ParsePDFObj(\@pdfwds); my $o=$pdf->[$curobj]; - push(@ObjStm,$curobj) if (ref($o->{OBJ}) eq 'HASH' and exists($o->{OBJ}->{Type}) and $o->{OBJ}->{Type} eq '/ObjStm'); - $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})) + if (ref($o->{OBJ}) eq 'HASH' and exists($o->{OBJ}->{Type}) and $o->{OBJ}->{Type} eq '/ObjStm') { - $pdf->[0]->{OBJ}=ParsePDFObj(\@pdfwds); - } - else - { -# print "Skip '$wd'\n"; - } - } - - foreach my $ObjStm (@ObjStm) - { - LoadStream($pdf->[$ObjStm],$pdf); - my $pos=$pdf->[$ObjStm]->{OBJ}->{First}; - my $s=$pdf->[$ObjStm]->{STREAM}; - $s=~s/\%.*?$//m; + 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)); @@ -2459,10 +2442,22 @@ sub LoadPDF 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}=ObjMerge($pdf->[$o[$j]]->{OBJ},ParsePDFObj(\@w)); + $pdf->[$o[$j]]->{OBJ}=ParsePDFObj(\@w); } - $pdf->[$ObjStm]=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'; + } + elsif ($wd eq 'trailer' and !exists($pdf->[0]->{OBJ})) + { + $pdf->[0]->{OBJ}=ParsePDFObj(\@pdfwds); + } + else + { + # print "Skip '$wd'\n"; + } } $pdf->[0]=$pdf->[$root] if !defined($pdf->[0]); @@ -2514,9 +2509,8 @@ sub LoadPDF 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}); @@ -2541,22 +2535,6 @@ sub LoadPDF return([$xonm,$BBox] ); } -sub ObjMerge -{ - my $o1=shift; - my $o2=shift; - - return $o1 if !defined($o2); - return $o2 if !defined($o1); - - foreach my $k (keys %{$o2}) - { - $o1->{$k}=$o2->{$k}; - } - - return $o1; -} - sub LoadStream { my $o=shift; @@ -2612,6 +2590,7 @@ sub BuildStream $obj[$xobj]->{STREAM}=$strm; } + sub MapInsHash { my $pdf=shift; @@ -2620,6 +2599,7 @@ 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'; @@ -2668,6 +2648,7 @@ sub MapInsValue { MapInsHash($pdf,$o,$insmap,$parent,$val); } + } sub FindKey @@ -2762,6 +2743,7 @@ sub nextwd sub ParsePDFObj { + my $pdfwds=shift; my $rtn; my $wd; @@ -2955,21 +2937,9 @@ sub ParsePDFArray return($rtn); } -sub Notice -{ - if ($debug) - { - unshift(@_, "debug: "); - my $msg=join('',@_); - Msg(0,$msg); - } -} - sub Warn { - unshift(@_, "warning: "); - my $msg=join('',@_); - Msg(0,$msg); + Msg(0,(@_)); } sub Die @@ -2989,6 +2959,10 @@ sub Msg { print STDERR "fatal error: "; } + else + { + print STDERR "warning: "; + } print STDERR "$msg\n"; exit 1 if $fatal; @@ -3154,8 +3128,8 @@ sub EmbedFont $objct+=2; $fontlst{$fontno}->{NM}='/F'.$fontno; $pages->{'Resources'}->{'Font'}->{'F'.$fontno}=$fontlst{$fontno}->{OBJ}; -# $fontlst{$fontno}->{FNT}=$fnt; -# $obj[$objct]->{STREAM}=$t1stream; + # $fontlst{$fontno}->{FNT}=$fnt; + # $obj[$objct]->{STREAM}=$t1stream; return($st+2); } @@ -3232,7 +3206,7 @@ sub LoadFont $r[0]='u0020' if $r[3] == 32; $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{NAM}->{$r[0]}=[$p[0],$r[3],'/'.$r[4],undef,undef,$r[5],$p[1]||0,$p[2]||0]; $fnt{NO}->[$r[3]]=$r[0]; $lastnm=$r[0]; $lastchr=$r[3] if $r[3] > $lastchr; @@ -3260,12 +3234,12 @@ sub LoadFont $fnt{ascent}=$ascent; $fnt{capheight}=$capheight; $fnt{lastchr}=$lastchr; - $fnt{NAM}->{''}=[0,-1,'/.notdef',-1,0]; + $fnt{NAM}->{''}=[0,-1,'/.notdef',-1,0,0,0]; $slant=-$fnt{'slant'} if exists($fnt{'slant'}); $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'}); - Notice("Using nospace mode for font '$ofontnm'") if $fnt{nospace} == 1 and $options & USESPACE; + 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; @@ -3285,8 +3259,8 @@ sub LoadFont # $fontlst{$fontno}->{HEAD}=$head; # $fontlst{$fontno}->{BODY}=$body; # $fontlst{$fontno}->{TAIL}=$tail; -# $fno=++$objct; -# EmbedFont($fontno,\%fnt); + # $fno=++$objct; + # EmbedFont($fontno,\%fnt); } else { @@ -3316,10 +3290,10 @@ sub LoadFont } } -# 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 @@ -3548,7 +3522,7 @@ sub NewPage $stream.=$strkcol."\n", $curstrk=$strkcol if $strkcol ne ''; $mode='g'; $curfill=''; -# @mediabox=@defaultmb; + # @mediabox=@defaultmb; } sub DrawBox @@ -3589,7 +3563,7 @@ sub do_f my $fnt=$fontlst{$par}->{FNT}; $thisfnt=$fnt; -# IsText(); + # IsText(); $cft="$par"; $fontchg=1; PutLine(); @@ -3669,14 +3643,11 @@ 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:- # @@ -3690,7 +3661,7 @@ sub do_m $par=substr($par,1); $par=~s/^ +//; -# IsGraphic(); + # IsGraphic(); $textcol=set_col($mcmd,$par,0); $strkcol=set_col($mcmd,$par,1); @@ -3908,8 +3879,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"; @@ -3927,8 +3898,7 @@ 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); @@ -4057,6 +4027,7 @@ sub FindCircle { return(-1); } + } sub PtoR @@ -4075,6 +4046,7 @@ sub RtoP sub PutLine { + my $f=shift; IsText() if !defined($f); @@ -4124,8 +4096,8 @@ sub PutLine { $stream.="%!! GAP=".($gap)."\n" if $debug; -# while ($gap >= $whtsz+$wt) -# while (abs($gap - ($whtsz+$wt)) > 1) + # while ($gap >= $whtsz+$wt) + # while (abs($gap - ($whtsz+$wt)) > 1) if ($wt >= 0) { my $i=int(($gap+1) / ($whtsz+$wt)); @@ -4172,6 +4144,7 @@ sub PutLine $n=0; } + } else { @@ -4263,7 +4236,7 @@ sub AssignGlyph ($chf->[MINOR],$chf->[MAJOR])=NextAlloc($fnt); } -# $fnt->{SUB}->[$chf->[MAJOR]]->{CHARSET}.=$chf->[PSNAME]; + # $fnt->{SUB}->[$chf->[MAJOR]]->{CHARSET}.=$chf->[PSNAME]; my $uc; @@ -4299,7 +4272,7 @@ sub PutGlyph { PutLine(); $cftmajor=$chf->[MAJOR]; -# $whtsz=$fontlst{$cft}->{FNT}->{spacewidth}*$cftsz; + # $whtsz=$fontlst{$cft}->{FNT}->{spacewidth}*$cftsz; my $c=$cft; $c.=".".$cftmajor if $cftmajor; $stream.="/F$c $cftsz Tf\n"; @@ -4373,6 +4346,7 @@ sub do_t PutGlyph($fnt,$ch,0); } + } sub do_u @@ -4391,7 +4365,7 @@ sub do_h $v/=$unitwidth; - if ($mode eq 't') + if ( $mode eq 't') { if ($w_flg) { @@ -4436,7 +4410,7 @@ sub do_H if ($mode eq 't') { -# PutLine(); + # PutLine(); if ($#lin > -1) { $lin[$#lin]->[HWID]=d3($xpos-$lin[$#lin]->[XPOS]); @@ -4601,7 +4575,7 @@ sub map_subrs for (my $j=0; $j<=$#{$lines}; $lin=$lines->[++$j] ) { -# next if !defined($lines->[$j]); + # next if !defined($lines->[$j]); if ($stage == 0) { @@ -4643,8 +4617,8 @@ sub map_subrs redo; } -# $s=decrypt_char($s); -# subs_call($s,"#$n"); + # $s=decrypt_char($s); + # subs_call($s,"#$n"); $lines->[$i]=["#$n",$l,$s,'NP']; } elsif ($lin=~m/^ND/) @@ -4695,10 +4669,10 @@ sub map_subrs $i=0; } -# else -# { -# Warn("Don't understand '$lin'"); -# } + # else + # { + # Warn("Don't understand '$lin'"); + # } } elsif ($stage == 3) { @@ -4759,11 +4733,7 @@ sub subs_call my $n2=$charstr->[++$j]; push(@c,[$n2,0]); - if ($n2==16) # callothersub - { - $c[$#c-4]->[0]=MarkSub("#$c[$#c-4]->[0]") if ($c[$#c-4]->[1]); - } - elsif ($n2==6) # seac + if ($n2==6) # seac { my $ch=$StdEnc{$c[$#c-2]->[0]}; my $chf; @@ -4803,7 +4773,7 @@ sub subs_call $sec{$key}->[CHARCHAR]=\@c; -# foreach my $j (@c) {Warn("Undefined op in $key") if !defined($j);} + # foreach my $j (@c) {Warn("Undefined op in $key") if !defined($j);} } sub Subset @@ -4960,14 +4930,13 @@ sub encode_charstr 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); -# } + # 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 ); + push(@c,255,($n >> 24) & 0xff, ($n >> 16) & 0xff, ($n >> 8) & 0xff, $n & 0xff ); } } else