# # Perl subroutines to support the AFM to TFM font conversion # scripts using fontinst # # Sebastian Rahtz, January 1997 # # 1.0 January 1997 # 1.1 1997/02/09 # 1.2 1997/02/13 #----------------------------------------------------------------- sub Setup { my ($JOB) = @_; # # get the date right # ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); $year = $year + 1900; $mon = $mon +1 ; if ($mon < 10) { $mon= "0" . $mon; } # # find the root of the TDS tree (I am assuming you use tetex/web2c 7, ok?) # if ($opt_texmf eq "") { if ($opt_tetex) { open(SH,"kpsexpand '\$TEXMF' |") || die "cannot run kpsexpand"; } else { open(SH,"kpsewhich -separator=\" \" -expand-path '\$TEXMFMAIN' |") || die "cannot run kpsewhich"; } $opt_texmf=; close(SH); chop($opt_texmf); $opt_texmf =~ s/ .*//; } if ($opt_tetex) { $KPSETFM="tfm" ; $KPSEAFM="tex"; } else { $KPSETFM=""; $KPSEAFM=""; } print "TEXMF is $opt_texmf\n" ; $Inidir = getcwd(); $ENV{TEXINPUTS}="$Inidir/finst:$opt_texmf/fonts/afm//:"; $ENV{TFMFONTS}=".:"; if ($opt_outdir eq "") { $opt_outdir=$Inidir; } &readfontnames; $_=$JOB; ($sname,$fname,$famextra) = /(.)(..)(.*)/; $Famcode=$sname . $fname; $Foundry=$Foundries{$sname}; $Family=$Typefaces{$fname}; $ShortFamily=$Shortnames{$fname}; system("rm -f $Foundry-$ShortFamily"); $Outdir="$opt_outdir/$ShortFamily"; mkdir("$opt_outdir",0777); mkdir("$opt_outdir/$ShortFamily",0777); mkdir("$Outdir/dvips",0777); mkdir("$Outdir/tfm",0777); mkdir("$Outdir/vf",0777); mkdir("$Outdir/tex",0777); print "work on $Famcode$opt_expert ($famextra) / $ShortFamily / $Family\n" if $opt_verbose; # # convert relative path to absolute, since we are operating from /tmp # chdir("$Outdir"); $Outdir = getcwd(); print "results to $Outdir\n"; mkdir("/tmp/Fam_$$",0777); chdir("/tmp/Fam_$$"); } #----------------------------------------------------------------- sub buildfilelist { opendir(DIR,'.') || die ("ERROR: cannot open directory"); @filenames =grep(!/^\.\.?$/,readdir(DIR)); closedir(DIR); } #----------------------------------------------------------------- sub readfontnames { my $colA,$colB,$ColC,$ColD; open(INF,"$opt_texmf/fontname/supplier.map") || die "cannot open $opt_texmf/fontname/supplier.map"; while (){ if (!/^@/) { ($ColA,$ColB,$ColC)=split; $Foundries{$ColA} =$ColB; } } close(INF); open(INF,"$opt_texmf/fontname/typeface.map") || die "cannot open $opt_texmf/fontname/supplier.map"; while (){ if (!/^@/) { ($ColA,$ColB,$ColC,$ColD)=split; $Typefaces{$ColA} =$ColC; $Shortnames{$ColA} =$ColB; } } close(INF); } #----------------------------------------------------------------- sub readAFMfile { my ($AFMfile) = @_; my $FontName; open(AFM,$AFMfile); while () { if (/^FontName /) { ($FontName) = /^FontName ([A-z0-9\-]*)/ ; return $FontName; } } close(AFM); return ""; } #----------------------------------------------------------------- sub installDvips { if ($opt_tetex) { $TeXBaseEncoding=`kpsewhich dvips_config 8r.enc 2> /dev/null`; } else { $TeXBaseEncoding=`kpsewhich -format=34 8r.enc 2> /dev/null`; } chop $TeXBaseEncoding; open(MAP,">>$Outdir/dvips/$Famcode.map"); # 8r names print "** Making map entries for 8r *.pl files\n"; for (grep(/.*8r.*\.pl/,@filenames)) { s/\.pl//; $Basefile=$_; s/8r/8a/; $Rawfile=$_; $AFMfile=`kpsewhich $KPSEAFM $_.afm 2> /dev/null`; chop $AFMfile ; if ($AFMfile ne "") { $FontName=&readAFMfile($AFMfile); $FullNames{$Basefile}=$FontName; print MAP "$Basefile $FontName \"TeXBase1Encoding ReEncodeFont \" <8r.enc "; if ($opt_download) { print MAP "<$Rawfile.pfb"; } print MAP "\n"; &make_tfm($Basefile,$AFMfile,"-e$TeXBaseEncoding"); } } # 8x names print "** Making map entries for 8x *.pl files\n" if $opt_verbose; for (grep(/.*8x.*\.pl/,@filenames)) { s/\.pl//; $Basefile=$_; $AFMfile=`kpsewhich $KPSEAFM $_.afm 2> /dev/null`; chop $AFMfile ; if ($AFMfile ne "") { $FontName=&readAFMfile($AFMfile); $FullNames{$Basefile}=$FontName; print MAP "$Basefile $FontName "; if ($opt_download) { print MAP "<$Basefile.pfb"; } print MAP "\n"; &make_tfm($Basefile,$AFMfile,""); } } print "** Making map entries for faked fonts\n" if $opt_verbose; open LOG,"grep \"^Faking \" *.log| " || die "cannot open grep for Faking"; while () { ($Style,$Fake,$Real)=/Faking (.*) font (.*) from (.*)/; $_=$Real; ($Up,$Enc,$Suf) = /(.*)(8.)(.*)/; $Basefile="$Up$Enc$Suf"; $Enc =~ s/8r/8a/; $Rawfile="$Up$Enc$Suf"; $AFMfile=`kpsewhich $KPSEAFM $Rawfile.afm 2> /dev/null`; chop $AFMfile ; $csargs=""; if ($AFMfile ne "") { $FontName=&readAFMfile($AFMfile); print MAP "$Fake $FontName \""; if ($Style eq "narrow") { print MAP " $opt_narrow ExtendFont " ; $csargs=" -E$opt_narrow "; } elsif ($Style eq "oblique") { print MAP " $opt_slant SlantFont " ; $csargs=" -S$opt_slant "; } if ($Enc ne "8x") { print MAP "TeXBase1Encoding ReEncodeFont \" <8r.enc"; $csargs .= "-e$TeXBaseEncoding "; } else { print MAP "\"";} if ($opt_download) { print MAP " <$Rawfile.pfb " ; } print MAP "\n"; &make_tfm($Fake,$AFMfile,$csargs); } } close LOG; close MAP; open CONFIG,">>$Outdir/dvips/config.$Famcode"; print CONFIG "p +$Famcode.map\n" ; close CONFIG; } #----------------------------------------------------------------- sub installMetrics { print "** Making virtual fonts with vptovf\n" if $opt_verbose; for (grep(/.*\.vpl/,@filenames)) { s/.vpl//; my $Basename=$_; processVPL($Basename); } &buildfilelist; print "** Installing TFM files in $Outdir/tfm\n" if $opt_verbose; for (grep(/.*\.tfm/,@filenames)) { print "Installing $_ \n" if $opt_verbose; if (! -r "$Outdir/tfm/$_") { system("mv $_ $Outdir/tfm") ; } } print "** Installing VF files in $Outdir/vf\n" if $opt_verbose; for (grep(/.*\.vf/,@filenames)) { print "Installing $_ \n" if $opt_verbose; if (! -r "$Outdir/vf/$_") { system("mv $_ $Outdir/vf") ; } } } #----------------------------------------------------------------- sub make_tfm { # Add CHECKSUM in the same way as AFM2TFM and PS2PK do # This is originally by Piet Tutelaers local($texname,$afmfile,$csargs) = @_; local $cs = 0; if (-r "$texname.tfm") { chop($cs = `cs -o "$texname.tfm"`); return $cs; } chop($cs = `cs -n -o $csargs $afmfile`); print "make tfm $texname, $afmfile, $csargs\n" if $opt_debug; die "[addchecksum] cs: exit code ", ($? >>8) & 255, "\n" if $cs == 0 && $?; die "[addchecksum] Wrong checksum for $texname\n" if "$cs" eq ""; print "$texname.pl: cs -n -o $csargs $afmfile -> $cs\n" if $opt_verbose; die "[addchecksum] Can not open $texname.pl\n" unless open(PL, "<$texname.pl"); $csadded = 0; open(TMPPL, ">tmp.pl"); print TMPPL "(COMMENT new CHECKSUM added)\n"; while () { if (/CHECKSUM/) { print TMPPL "(CHECKSUM O $cs)\n"; $csadded = 1; next; } if ($csadded == 0 && /FONTDIMEN/) { print TMPPL "(CHECKSUM O $cs)\n"; $csadded = 1; } print TMPPL; } close(PL); close(TMPPL); unlink("$texname.pl"); rename("tmp.pl", "$texname.pl"); print "pltotf $texname.pl $texname.tfm\n" if $opt_debug; system("pltotf $texname.pl $texname.tfm"); die "[addchecksum] pltotf: exit code ", ($? >>8) & 255, "\n" if $?; return $cs; } #----------------------------------------------------------------- sub processVPL { # This is originally by Piet Tutelaers local($font) = @_; print "Processing $font.vpl\n" if $opt_verbose; open(VPL,"$font.vpl") || die "cannot open VPL $font.vpl"; open(TMPVPL, ">tmp.vpl"); print TMPVPL "(COMMENT new FONTCHECKSUMs added)\n"; while () { $vpl = $_; next if (/FONTCHECKSUM/); if (/FONTNAME/) { $offset = index($vpl, "FONTNAME"); $offset = index($vpl, ")", $offset); die "[addchecksum] Expected a closing brace after FONTNAME in line:", "\n$vpl" if $offset == -1; ($fontname) = ($vpl =~ /FONTNAME\s+(\w+)/); $cs = 0; if (-r "$fontname.tfm") { chop($cs = `cs -o "$fontname.tfm"`); print "Read $cs from $fontname.tfm\n" if $opt_verbose; } elsif (-r "$fontname.pl") { $_=$fontname; s/8r/8a/; $AFMfile=`kpsewhich $KPSEAFM $_.afm 2> /dev/null`; chop($AFMfile); if ($AFMfile eq "") { die "No AFM file found for font $_\n"; } else { $cs= &make_tfm($fontname,$AFMfile,""); print "Generated $cs from $fontname.pl\n" if $opt_verbose; die "[addchecksum] $fontname: invalid checksum" unless $cs != 0; } } else { # see it exists on the system $TFMfile=`kpsewhich $KPSETFM $fontname.tfm 2> /dev/null`; chop($TFMfile); if ($TFMfile ne "") { chop($cs = `cs -o "$TFMfile"`); print "Read $cs from $TFMfile\n" if $opt_verbose; } else { die "[addchecksum] No font for $fontname\n"; } } die "[addchecksum] cs: exit code ", ($? >>8) & 255, "\n" if $cs == 0 && $?; substr($vpl, $offset+1, 0) = " (FONTCHECKSUM O $cs) "; } print TMPVPL $vpl; } close(VPL); close(TMPVPL); unlink("$font.vpl"); rename("tmp.vpl", "$font.vpl"); system("vptovf $font.vpl $font.vf $font.tfm"); die "[addchecksum] vptovf: exit code ", ($? >>8) & 255, "\n" if $?; } #----------------------------------------------------------------- sub runTeX { open(TEX,">Fam_$$.tex") || die ("Cannot open Fam_$$.tex"); if ($opt_verbose) { print TEX "\\nonstopmode\n" ; } else { print TEX "\\batchmode\n" ; } print TEX "\\input fontinst.sty\n"; print TEX "\\input textcomp\n"; print TEX "\\def\\SlantAmount{",$opt_slant * 1000,"}\n"; if ($opt_narrow) { print TEX "\\fakenarrow{$opt_narrow}\n" ; } print TEX "\\latinfamily{$Famcode$opt_expert$famextra}{$ExtraFDcode}\n"; print TEX "\\textcompfamily{$Famcode$opt_expert$famextra}{}\n"; print TEX "\\end\n"; close TEX; system("initex Fam_$$"); } #----------------------------------------------------------------- sub installTeX { local $encoding; for (grep(/.*\.fd/,@filenames)) { if (! -r "$Outdir/tex/$_") { if (/^ot1/) { $encoding = "ot1"; } else { $encoding="other";} open NEWFD,">$Outdir/tex/$_"; open OLDFD,"$_"; while () { if ($opt_lucida) { s/DeclareFontShape/DeclareLucidaFontShape/; s/^\\DeclareFontFam/\\\@ifundefined{DeclareLucidaFontShape}{\%\n\\def\\DeclareLucidaFontShape#1#2#3#4#5#6{\%\n\\DeclareFontShape{#1}{#2}{#3}{#4}{<->#5}{#6}}}{}\n\\DeclareFontFam/; s/^ <-> //; if (/sub /) { s/Lucida//; } } if (/endinput/ && $encoding eq "ot1" ) { print NEWFD "\\DeclareFontShape{OT1}{$Famcode$famextra}{m}{ui}{<->ssub * $Famcode$famextra/m/it}{}\n"; print NEWFD "\\DeclareFontShape{OT1}{$Famcode$famextra}{b}{ui}{<->ssub * $Famcode$famextra/b/it}{}\n"; print NEWFD "\\endinput\n"; } else { print NEWFD ; } } close OLDFD; close NEWFD; } } # now we have to fix the silly OML and OMS files. bleeargh. # open(CAT,">$Outdir/tex/oms$Famcode$famextra$opt_expert.fd") || die ("cannot open $Outdir/tex/oms$Famcode$famextra$opt_expert.fd"); print CAT < ssub * cmsy/m/n}{} \\DeclareFontShape{OMS}{$Famcode$famextra}{m}{it} {<-> ssub * cmsy/m/n}{} \\DeclareFontShape{OMS}{$Famcode$famextra}{m}{sl} {<-> ssub * cmsy/m/n}{} \\DeclareFontShape{OMS}{$Famcode$famextra}{m}{sc} {<-> ssub * cmsy/m/n}{} \\DeclareFontShape{OMS}{$Famcode$famextra}{b}{n} {<-> ssub * cmsy/b/n}{} \\DeclareFontShape{OMS}{$Famcode$famextra}{b}{it} {<-> ssub * cmsy/b/n}{} \\DeclareFontShape{OMS}{$Famcode$famextra}{b}{sl} {<-> ssub * cmsy/b/n}{} \\DeclareFontShape{OMS}{$Famcode$famextra}{b}{sc} {<-> ssub * cmsy/b/n}{} \\endinput EOFCAT close CAT; open (CAT,">$Outdir/tex/oml$Famcode$famextra$opt_expert.fd") || die ("cannot open $Outdir/tex/oml$Famcode$famextra$opt_expert.fd"); print CAT < ssub * cmm/m/it}{} \\DeclareFontShape{OML}{$Famcode$famextra}{m}{it} {<-> ssub * cmm/m/it}{} \\DeclareFontShape{OML}{$Famcode$famextra}{m}{sl} {<-> ssub * cmm/m/it}{} \\DeclareFontShape{OML}{$Famcode$famextra}{m}{sc} {<-> ssub * cmm/m/it}{} \\DeclareFontShape{OML}{$Famcode$famextra}{b}{n} {<-> ssub * cmm/b/it}{} \\DeclareFontShape{OML}{$Famcode$famextra}{b}{it} {<-> ssub * cmm/b/it}{} \\DeclareFontShape{OML}{$Famcode$famextra}{b}{sl} {<-> ssub * cmm/b/it}{} \\DeclareFontShape{OML}{$Famcode$famextra}{b}{sc} {<-> ssub * cmm/b/it}{} \\endinput EOFCAT open(README,">$Outdir/README"); print "Installing README in $Outdir\n" if $opt_verbose; print README <$Outdir/tex/$opt_expert$ShortFamily.sty"); print CAT <) { $Lines{$_} = 1; } close(TMP); open (TMP,">$filename") || die "Cannot write $filename to remove duplicates"; foreach $l (sort keys %Lines) { print TMP $l; } close(TMP); } # # remove all files corresponding to a pattern # sub killfiles { local($killpatt) = @_; for (grep(/$killpatt/,@filenames)) { print "NOTE: removing $_\n" if ($opt_debug); unlink $_ ; } &buildfilelist; } 1;