diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-15 19:44:05 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-15 19:44:05 +0000 |
commit | d318611dd6f23fcfedd50e9b9e24620b102ba96a (patch) | |
tree | 8b9eef82ca40fdd5a8deeabf07572074c236095d /font/devpdf/util | |
parent | Initial commit. (diff) | |
download | groff-upstream/1.23.0.tar.xz groff-upstream/1.23.0.zip |
Adding upstream version 1.23.0.upstream/1.23.0upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to '')
-rw-r--r-- | font/devpdf/util/BuildFoundries.pl | 578 |
1 files changed, 578 insertions, 0 deletions
diff --git a/font/devpdf/util/BuildFoundries.pl b/font/devpdf/util/BuildFoundries.pl new file mode 100644 index 0000000..2815c37 --- /dev/null +++ b/font/devpdf/util/BuildFoundries.pl @@ -0,0 +1,578 @@ +#!/usr/bin/perl +# +# BuildFoundries: Given a Foundry file, generate groff font description +# files and a "download" file so gropdf can embed fonts in PDF output. +# +# Copyright (C) 2011-2020 Free Software Foundation, Inc. +# Written by Deri James <deri@chuzzlewit.myzen.co.uk> +# +# This file is part of groff. +# +# groff is free software; you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free +# Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# groff is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <http://www.gnu.org/licenses/>. + +use strict; +use Getopt::Long; +use warnings; + +my $pathsep='@PATH_SEPARATOR@'; + +my $check=0; +my $dirURW=''; +my $beStrict=0; + +GetOptions("check" => \$check, "dirURW=s" => \$dirURW, + "strict" => \$beStrict); + +(my $progname = $0) =~s @.*/@@; +my $where=shift||''; +my @d=(split(':',shift||'../devps')); +my $devps=\@d; +chdir $where if $where ne ''; +my (%flg,@downloadpreamble,%download); +my $GSpath=FindGSpath(); +my $lct=0; +my $foundry=''; # the default foundry +my $notFoundFont=0; + +if ($check) +{ + CheckFoundry("Foundry.in"); + exit $notFoundFont; +} +else +{ + LoadDownload("download"); # not required + LoadFoundry("Foundry"); + WriteDownload(); +} +exit 0; + + + +sub LoadFoundry +{ + my $fn=shift; + my $foundrypath; + $notFoundFont=0; + + open(F,"<$fn") or Die("file '$fn' not found or not readable"); + + while (<F>) + { + chomp; + $lct++; + s/\r$//; # in case edited in windows + + s/\s*#.*?$//; # remove comments + + next if $_ eq ''; + + if (m/^[A-Za-z]=/) + { + my (@f)=split('='); + $flg{$f[0]}=$f[1]; + next; + } + + my (@r)=split('\|'); + + if (lc($r[0]) eq 'foundry') + { + Warn("\nThe path(s) used for searching:\n".join(':',@{$foundrypath})."\n") if $notFoundFont; + $foundry=uc($r[1]); + $foundrypath=[]; + push(@{$foundrypath},$dirURW) if $dirURW; + push(@{$foundrypath},(split(':',$r[2])),@{$devps}); + foreach my $j (0..$#{$foundrypath}) + { + if (defined($foundrypath->[$j]) + && $foundrypath->[$j]=~m'\s*\(gs\)') + { + splice(@{$foundrypath},$j,1,@{$GSpath}); + } + } + $notFoundFont=0; + } + else + { + # 0=groff font name + # 1=IsBase Y/N (one of PDFs 14 base fonts) + # 2=afmtodit flag + # 3=map file + # 4=encoding file + # 5=font file + + my $gfont=($foundry eq '')?$r[0]:"$foundry-$r[0]"; + + if ($r[2] eq '') + { + # Don't run afmtodit; just copy the groff font + # description file for grops. + my $gotf=1; + my $gropsfnt=LocateFile($devps,$r[0],0); + if ($gropsfnt ne '' and -r "$gropsfnt") + { + my $psfont=UseGropsVersion($gropsfnt); + # To be embeddable in PDF, the font file name itself + # needs to be located and written to "download". + if (!PutDownload($psfont, + LocatePF($foundrypath,$r[5]), + uc($r[1]))) + { + if (uc($r[1]) ne 'Y') + { + $gotf=0; + my $fns=join(', ',split('!',$r[5])); + Warn("groff font '$gfont' will not be" + . " available for PDF output; unable" + . " to locate font file(s): $fns"); + $notFoundFont=1; + unlink $gfont; + } + } + Notice("copied grops font $gfont") if $gotf; + + } + else + { + Warn("Can't read grops font '$r[0]' for Foundry '$foundry'"); + } + } + else + { + # Use afmtodit to create a groff font description file. + my $afmfile=LocateAF($foundrypath,$r[5]); + if (!$afmfile) { + my $sub=\&Warn; + $sub=\&Die if ($beStrict); + &$sub("cannot locate AFM file for font '$gfont'"); + next; + } + my $psfont=RunAfmtodit($gfont,$afmfile,$r[2],$r[3],$r[4]); + + if ($psfont) + { + if (!PutDownload($psfont,LocatePF($foundrypath,$r[5]),uc($r[1]))) + { + unlink $gfont; # Unable to find the postscript file for the font just created by afmtodit + } + else + { + Notice("generated $gfont"); + } + } + else + { + Warn("Failed to create groff font '$gfont' by running afmtodit"); + $notFoundFont=1; + } + } + } + } + + close(F); + Warn("\nThe path(s) used for searching:\n".join(':',@{$foundrypath})."\n") if $notFoundFont; +} + +sub RunAfmtodit +{ + my $gfont=shift; + my $afmfile=shift; + my $flags=shift; + my $map=shift||''; + my $enc=shift||''; + my $psfont=''; + + $enc="-e 'enc/$enc'" if $enc; + $map="'map/$map'" if $map; + + my $cmd='afmtodit -c -dDESC'; + + foreach my $f (split('',$flags)) + { + if (!exists($flg{$f})) + { + Warn("Can't use undefined flag '$f' in calling afmtodit for groff font '$gfont'"); + return(''); + } + + $cmd.=" $flg{$f}"; + } + + system("$cmd $enc '$afmfile' $map $gfont"); + + if ($?) + { + unlink $gfont; + return(''); + } + + if (open(GF,"<$gfont")) + { + my (@gf)=(<GF>); + my @ps=grep(/^internalname /,@gf); + if ($#ps == 0) # Just 1 match + { + (undef,$psfont)=split(' ',$ps[0],2); + chomp($psfont); + } + else + { + Warn("Unexpected format for grops font '$gfont' for Foundry '$foundry' - ignoring"); + } + + close(GF); + } + + return($psfont); +} + +sub LocateAF +{ + my $path=shift; + my $file=shift; + + return(LocateFile($path,$file,1)); +} + +sub LocatePF +{ + my $path=shift; + my $file=shift; + + return(LocateFile($path,$file,0)); +} + +sub LocateFile +{ + my $path=shift; + my $files=shift; + my $tryafm=shift; + return(substr($files,1)) if substr($files,0,1) eq '*'; + + foreach my $p (@{$path}) + { + next if !defined($p) or $p eq ';' or $p eq ':'; + $p=~s/^\s+//; + $p=~s/\s+$//; + $p=~s@/+$@@; + + next if $p=~m/^\%rom\%/; # exclude %rom% paths (from (gs)) + + foreach my $file (reverse(split('!',$files))) + { + if ($tryafm) + { + if (!($file=~s/\..+$/.afm/)) + { + # no extenaion + $file.='.afm'; + } + } + + if ($file=~m'/') + { + # path given with file name so no need to search the paths + + if (-r $file) + { + return($file); + } + + if ($tryafm and $file=~s'type1/'afm/'i) + { + if (-r "$file") + { + return($file); + } + } + + return(''); + } + + if ($path eq '(tex)') + { + my $res=`kpsewhich $file`; + return '' if $?; + chomp($res); + return($res); + } + + if (-r "$p/$file") + { + return("$p/$file"); + } + + my $ap=$p; + + if ($tryafm and $ap=~s'type1/'afm/'i) + { + if (-r "$ap/$file") + { + return("$ap/$file"); + } + } + } + } + + return(''); +} + +sub FindGSpath +{ + my (@res)=`@GHOSTSCRIPT@ -h 2>/dev/null`; + return [] if $?; + my $buildpath=[]; + my $stg=1; + + foreach my $l (@res) + { + chomp($l); + + if ($stg==1 and $l=~m/^Search path:/) + { + $stg=2; + } + elsif ($stg == 2) + { + if (substr($l,0,1) ne ' ') + { + $stg=3; + } + else + { + $l=~s/^\s+//; + $pathsep=';' if substr($l,-1) eq ';'; + push(@{$buildpath},(split("$pathsep",$l))); + } + } + } + + return($buildpath); +} + +sub UseGropsVersion +{ + my $gfont=shift; + my $psfont=''; + my (@gfa)=split('/',$gfont); + my $gfontbase=pop(@gfa); + + if (open(GF,"<$gfont")) + { + my (@gf)=(<GF>); + my @ps=grep(/^internalname /,@gf); + if ($#ps == 0) # Just 1 match + { + (undef,$psfont)=split(' ',$ps[0],2); + chomp($psfont); + } + else + { + Warn("Unexpected format for grops font '$gfont' for Foundry '$foundry' - ignoring"); + } + + close(GF); + + if ($psfont) + { + if (open(GF,">$gfontbase")) + { + local $"=''; + print GF "@gf"; + close(GF); + } + else + { + $psfont=''; + Warn("Failed to create new font '$gfont' for Foundry '$foundry'"); + } + } + else + { + Warn("Failed to locate postscript internalname in grops font '$gfont' for Foundry '$foundry'"); + } + + close(GF); + } + else + { + Warn("Failed to open grops font '$gfont' for Foundry '$foundry'"); + } + + return($psfont); +} + +sub PutDownload +{ + my $psfont=shift; + my $pffile=shift; + my $IsBase14=shift; + my $key="$foundry $psfont"; + + delete($download{$key}), return 0 if ($pffile eq ''); + + $pffile='*'.$pffile if $IsBase14 eq 'Y'; # This signals to gropdf to only edmbed if -e given + $download{$key}=$pffile; + + return 1; +} + +sub LoadDownload +{ + my $fn=shift; + + return if !open(F,"<$fn"); + + while (<F>) + { + chomp; + s/\r$//; # in case edited in windows + + if (substr($_,0,1) eq '#' or $_ eq '') + { + # Preserve comments at top of download file + + push(@downloadpreamble,$_); + next; + } + + s/\s*#.*?$//; # remove comments + + next if $_ eq ''; + + my (@r)=split(/\t+/); + my $key=$r[1]; + $key="$r[0] $r[1]"; + $download{$key}=$r[2]; + } + + close(F); +} + +sub WriteDownload +{ + print join("\n",@downloadpreamble),"\n"; + + foreach my $k (sort keys %download) + { + my ($f,$ps)=split(/ /,$k); + print "$f\t$ps\t$download{$k}\n"; + } +} + +sub Notice { + my $msg=shift; + Msg("notice: $msg"); +} + +sub Warn { + my $msg=shift; + Msg("warning: line $lct: $msg"); +} + +sub Die { + my $msg=shift; + Msg("error: $msg"); + exit 2; +} + +sub Msg { + my $msg=shift; + print STDERR "$progname: $msg\n"; +} + +sub CheckFoundry +{ + my $fn=shift; + my $foundrypath=[]; + $notFoundFont=0; + + open(F,"<$fn") or Die("file '$fn' not found or not readable"); + + while (<F>) + { + chomp; + s/\r$//; # in case edited in windows + + s/\s*#.*?$//; # remove comments + + next if $_ eq ''; + + if (m/^[A-Za-z]=/) + { + next; + } + + my (@r)=split('\|'); + + if (lc($r[0]) eq 'foundry') + { + $foundry=uc($r[1]); + $foundrypath=[]; + push(@{$foundrypath},$dirURW) if $dirURW; + push(@{$foundrypath},(split(':',$r[2])),$devps); + foreach my $j (0..$#{$foundrypath}) + { + if ($foundrypath->[$j]=~m'\s*\(gs\)') + { + splice(@{$foundrypath},$j,1,@{$GSpath}); + } + } + $notFoundFont=0; + } + else + { + # 0=groff font name + # 1=IsBase Y/N (one of PDFs 14 base fonts) + # 2=afmtodit flag + # 3=map file + # 4=encoding file + # 5=font file + + my $gfont=($foundry eq '')?$r[0]:"$foundry-$r[0]"; + + if ($r[2] eq '') + { + # Don't run afmtodit, just copy the grops font file + + my $gotf=1; + my $gropsfnt=LocateFile([$devps],$r[0],0); + + if ($gropsfnt ne '' and -r "$gropsfnt") + { + + } + else + { + $notFoundFont|=1; + } + } + else + { + # We need to run afmtodit to create this groff font + $notFoundFont|=2 if !LocateAF($foundrypath,$r[5]); + $notFoundFont|=1 if !LocatePF($foundrypath,$r[5]); + } + } + } + + close(F); +} + +# Local Variables: +# fill-column: 72 +# mode: CPerl +# End: +# vim: set cindent noexpandtab shiftwidth=4 softtabstop=4 textwidth=72: |