summaryrefslogtreecommitdiff
path: root/font/devpdf/util/BuildFoundries.pl
diff options
context:
space:
mode:
Diffstat (limited to 'font/devpdf/util/BuildFoundries.pl')
-rw-r--r--font/devpdf/util/BuildFoundries.pl439
1 files changed, 439 insertions, 0 deletions
diff --git a/font/devpdf/util/BuildFoundries.pl b/font/devpdf/util/BuildFoundries.pl
new file mode 100644
index 00000000..80756147
--- /dev/null
+++ b/font/devpdf/util/BuildFoundries.pl
@@ -0,0 +1,439 @@
+#!@PERLPATH@ -w
+#
+# BuildFoundries: Given a Foundry file generate groff and download files
+# Deri James: Monday 07 Feb 2011
+
+# Copyright (C) 2011 Free Software Foundation, Inc.
+# Written by Deri James <deri@chuzzlewit.demon.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;
+
+my $where=shift||'';
+chdir $where if $where ne '';
+my (%foundry,%flg,@downloadpreamble,%download);
+my $GSpath=FindGSpath();
+my $warn=0;
+my $lct=0;
+my $foundry=''; # the default foundry
+
+LoadDownload("download");
+LoadFoundry("Foundry");
+WriteDownload("download");
+
+exit $warn;
+
+
+sub LoadFoundry
+{
+ my $fn=shift;
+ my $foundrypath='';
+
+ open(F,"<$fn") or die "No $fn file found";
+
+ 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')
+ {
+ $foundry=uc($r[1]);
+ $foundrypath=$r[2];
+ }
+ 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
+ # 6=afm file
+
+ if (!defined($r[6]) or $r[6] eq '')
+ {
+ # if no afm file, have a guess!
+ $r[6]=substr($r[5],0,-3)."afm";
+ }
+
+ 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;
+
+ if (-r "../devps/$r[0]")
+ {
+ my $psfont=UseGropsVersion($r[0]);
+ if (!PutDownload($psfont,LocatePF($foundrypath,$r[5]),uc($r[1])))
+ {
+ if (uc($r[1]) ne 'Y')
+ {
+ $gotf=0;
+ Msg(0,"Unable to locate font '$r[5]' on the given path(s)");
+ unlink $gfont; # Unable to find the postscript file for the font just created by afmtodit
+ }
+ }
+ print STDERR "Copied grops font $gfont...\n" if $gotf;
+ }
+ else
+ {
+ Msg(0,"Can't read grops font '$r[0]' for Foundry '$foundry'");
+ }
+ }
+ else
+ {
+ # We need to run afmtodit to create this groff font
+ my $psfont=RunAfmtodit($gfont,LocateAF($foundrypath,$r[6]),$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
+ {
+ print STDERR "Generated $gfont...\n";
+ }
+ }
+ else
+ {
+ Msg(0,"Failed to create groff font '$gfont' by running afmtodit");
+ }
+ }
+ }
+ }
+
+ close();
+}
+
+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}))
+ {
+ Msg(0,"Can't use undefined flag '$f' in calling afmtodit for groff font '$gfont'");
+ return('');
+ }
+
+ $cmd.=" $flg{$f}";
+ }
+
+ system("$cmd $enc '$afmfile' $map $gfont 2>/dev/null");
+
+ 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
+ {
+ Msg(0,"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 $file=shift;
+ my $tryafm=shift;
+
+ 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 '(gs)')
+ {
+ $path=$GSpath;
+ }
+ elsif ($path eq '(tex)')
+ {
+ my $res=`kpsewhich $file`;
+ return '' if $?;
+ chomp($res);
+ return($res);
+ }
+
+ my (@paths)=split(':',$path);
+
+ foreach my $p (@paths)
+ {
+ $p=~s/^\s+//;
+ $p=~s/\s+$//;
+
+ next if $p=~m/^\%rom\%/; # exclude %rom% paths (from (gs))
+
+ if (-r "$p/$file")
+ {
+ return("$p/$file");
+ }
+
+ if ($tryafm and $p=~s'type1/'afm/'i)
+ {
+ if (-r "$p/$file")
+ {
+ return("$p/$file");
+ }
+ }
+ }
+
+ return('');
+}
+
+sub FindGSpath
+{
+ my (@res)=`gs -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+//;
+ $buildpath.=$l;
+ }
+ }
+ }
+
+ return($buildpath);
+}
+
+sub UseGropsVersion
+{
+ my $gfont=shift;
+ my $psfont='';
+
+ if (open(GF,"<../devps/$gfont"))
+ {
+ my (@gf)=(<GF>);
+ my @ps=grep(/^internalname /,@gf);
+ if ($#ps == 0) # Just 1 match
+ {
+ (undef,$psfont)=split(' ',$ps[0],2);
+ chomp($psfont);
+ }
+ else
+ {
+ Msg(0,"Unexpected format for grops font '$gfont' for Foundry '$foundry' - ignoring");
+ }
+
+ close(GF);
+
+ if ($psfont)
+ {
+ if (open(GF,">$gfont"))
+ {
+ local $"='';
+ print GF "@gf";
+ close(GF);
+ }
+ else
+ {
+ $psfont='';
+ Msg(0,"Failed to create new font '$gfont' for Foundry '$foundry'");
+ }
+ }
+ else
+ {
+ Msg(0,"Failed to locate postscript internalname in grops font '$gfont' for Foundry '$foundry'");
+ }
+
+ close(GF);
+ }
+ else
+ {
+ Msg(0,"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;
+ my $top=1;
+
+ return if !open(F,"<$fn");
+
+ while (<F>)
+ {
+ chomp;
+ s/\r$//; # in case edited in windows
+
+ if ($top and substr($_,0,1) eq '#' or $_ eq '')
+ {
+ # Preserve comments at top of download file
+
+ push(@downloadpreamble,$_);
+ next;
+ }
+
+ $top=0;
+ 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
+{
+ my $fn=shift;
+ my $top=1;
+
+ open(F,">$fn") or die "Can't Create new file '$fn'";
+
+ print F join("\n",@downloadpreamble),"\n";
+
+ foreach my $k (sort keys %download)
+ {
+ my ($f,$ps)=split(/ /,$k);
+ print F "$f\t$ps\t$download{$k}\n";
+ }
+
+ close(F);
+}
+
+sub Msg
+{
+ my $sev=shift;
+ my $msg=shift;
+
+ if ($sev)
+ {
+ print STDERR "Error: line $lct: $msg\n";
+ exit 2;
+ }
+ else
+ {
+ print STDERR "Warning: line $lct: $msg\n";
+ $warn=1;
+ }
+}