texfont.pl /size: 47 Kb    last modification: 2020-07-01 14:35
1eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
2        if 0;
3
4# This is an example of a crappy unstructured file but once
5# I know what should happen exactly, I will clean it up.
6
7# once it works all right, afmpl will be default
8
9# todo : ttf (partially doen already)
10
11# added: $pattern in order to avoid fuzzy shelle expansion of
12# filenames (not consistent over perl and shells); i hate that
13# kind of out of control features.
14
15#D \module
16#D   [       file=texfont.pl,
17#D        version=2004.02.06, % 2000.12.14
18#D          title=Font Handling,
19#D       subtitle=installing and generating,
20#D         author=Hans Hagen ++,
21#D           date=\currentdate,
22#D      copyright={PRAGMA / Hans Hagen \& Ton Otten}]
23#C
24#C This module is part of the \CONTEXT\ macro||package and is
25#C therefore copyrighted by \PRAGMA. See licen-en.pdf for
26#C details.
27
28#D For usage information, see \type {mfonts.pdf}.
29
30#D Todo : copy afm/pfb from main to local files to ensure metrics
31#D Todo : Wybo's help system
32#D Todo : list of encodings [texnansi, ec, textext]
33
34#D Thanks to George N. White III for solving a couple of bugs.
35#D Thanks to Adam T. Lindsay for adding Open Type support (and more).
36
37use strict ;
38
39my $savedoptions = join (" ",@ARGV) ;
40
41use Config ;
42use FindBin ;
43use File::Copy ;
44use Getopt::Long ;
45use Data::Dumper;
46
47$Getopt::Long::passthrough = 1 ; # no error message
48$Getopt::Long::autoabbrev  = 1 ; # partial switch accepted
49
50# Unless a user has specified an installation path, we take
51# the dedicated font path or the local path.
52
53## $dosish = ($Config{'osname'} =~ /dos|mswin/i) ;
54my $dosish = ($Config{'osname'} =~ /^(ms)?dos|^os\/2|^(ms|cyg)win/i) ;
55
56my $IsWin32 = ($^O =~ /MSWin32/i);
57my $SpacyPath = 0 ;
58
59# great, the win32api is not present in all perls
60
61BEGIN {
62    $IsWin32 = ($^O =~ /MSWin32/i) ;
63    $SpacyPath = 0 ;
64    if ($IsWin32) {
65        my $str = `kpsewhich -expand-path=\$TEXMF` ;
66        $SpacyPath = ($str =~ / /) ;
67        if ($SpacyPath) {
68            require Win32::API; import Win32::API;
69        }
70    }
71}
72
73# great, glob changed to bsd glob in an incompatible way ... sigh, we now
74# have to catch a failed glob returning the pattern
75#
76# to stupid either:
77#
78# sub validglob {
79#     my @globbed = glob(shift) ;
80#     if ((@globbed) &&  (! -e $globbed[0])) {
81#        return () ;
82#     } else {
83#        return @globbed ;
84#     }
85# }
86#
87# so now we have:
88
89sub validglob {
90    my @globbed = glob(shift) ;
91    my @globout = () ;
92    foreach my $file (@globbed) {
93        push (@globout,$file) if (-e $file) ;
94    }
95    return @globout ;
96}
97
98sub GetShortPathName {
99    my ($filename) = @_ ;
100    return $filename unless (($IsWin32)&&($SpacyPath)) ;
101    my $GetShortPathName = new Win32::API('kernel32', 'GetShortPathName', 'PPN', 'N') ;
102    if(not defined $GetShortPathName) {
103      die "Can't import API GetShortPathName: $!\n" ;
104    }
105    my $buffer = " " x 260;
106    my $len = $GetShortPathName->Call($filename, $buffer, 260) ;
107    return substr($buffer, 0, $len) ;
108}
109
110my $installpath = "" ;
111
112if (defined($ENV{TEXMFLOCAL})) {
113    $installpath = "TEXMFLOCAL" ;
114}
115
116if (defined($ENV{TEXMFFONTS})) {
117    $installpath = "TEXMFFONTS" ;
118}
119
120if ($installpath eq "") {
121    $installpath = "TEXMFLOCAL" ; # redundant
122}
123
124my $encoding        = "texnansi" ;
125my $vendor          = "" ;
126my $collection      = "" ;
127my $fontroot        = "" ; #/usr/people/gwhite/texmf-fonts" ;
128my $help            = 0 ;
129my $makepath        = 0 ;
130my $show            = 0 ;
131my $install         = 0 ;
132my $sourcepath      = "." ;
133my $passon          = "" ;
134my $extend          = "" ;
135my $narrow          = "" ;
136my $slant           = "" ;
137my $spaced          = "" ;
138my $caps            = "" ;
139my $noligs          = 0 ;
140my $nofligs         = 0 ;
141my $test            = 0 ;
142my $virtual         = 0 ;
143my $novirtual       = 0 ;
144my $listing         = 0 ;
145my $remove          = 0 ;
146my $expert          = 0 ;
147my $trace           = 0 ;
148my $afmpl           = 0 ;
149my $trees           = 'TEXMFFONTS,TEXMFLOCAL,TEXMFEXTRA,TEXMFMAIN,TEXMFDIST' ;
150my $pattern         = '' ;
151my $uselmencodings  = 0 ;
152
153my $fontsuffix  = "" ;
154my $namesuffix  = "" ;
155
156my $batch = "" ;
157
158my $weight = "" ;
159my $width = "" ;
160
161my $preproc         = 0 ;     # atl: formerly OpenType switch
162my $variant         = "" ;    # atl: encoding variant
163my $extension       = "pfb" ; # atl: default font extension
164my $lcdf            = "" ;    # atl: trigger for lcdf otftotfm
165
166my @cleanup         = () ;    # atl: build list of generated files to delete
167
168# todo: parse name for style, take face from command line
169#
170# @Faces  = ("Serif","Sans","Mono") ;
171# @Styles = ("Slanted","Spaced", "Italic","Bold","BoldSlanted","BoldItalic") ;
172#
173# for $fac (@Faces) { for $sty (@Styles) { $FacSty{"$fac$sty"} = "" } }
174
175&GetOptions
176  ( "help"         => \$help,
177    "makepath"     => \$makepath,
178    "noligs"       => \$noligs,
179    "nofligs"      => \$nofligs,
180    "show"         => \$show,
181    "install"      => \$install,
182    "encoding=s"   => \$encoding,
183    "variant=s"    => \$variant,  # atl: used as a suffix to $encfile only
184    "vendor=s"     => \$vendor,
185    "collection=s" => \$collection,
186    "fontroot=s"   => \$fontroot,
187    "sourcepath=s" => \$sourcepath,
188    "passon=s"     => \$passon,
189    "slant=s"      => \$slant,
190    "spaced=s"     => \$spaced,
191    "extend=s"     => \$extend,
192    "narrow=s"     => \$narrow,
193    "listing"      => \$listing,
194    "remove"       => \$remove,
195    "test"         => \$test,
196    "virtual"      => \$virtual,
197    "novirtual"    => \$novirtual,
198    "caps=s"       => \$caps,
199    "batch"        => \$batch,
200    "weight=s"     => \$weight,
201    "width=s"      => \$width,
202    "expert"       => \$expert,
203    "afmpl"        => \$afmpl,
204    "afm2pl"       => \$afmpl,
205    "lm"           => \$uselmencodings,
206    "rootlist=s"   => \$trees,
207    "pattern=s"    => \$pattern,
208    "trace"        => \$trace,    # --verbose conflicts with --ve
209    "preproc"      => \$preproc,  # atl: trigger conversion to pfb
210    "lcdf"         => \$lcdf ) ;  # atl: trigger use of lcdf fonttoools
211
212# for/from Fabrice:
213
214my $own_path = "$FindBin::Bin/" ;
215
216$FindBin::RealScript =~ m/([^\.]*)(\.pl|\.bat|\.exe|)/io ;
217
218my $own_name = $1 ;
219my $own_type = $2 ;
220my $own_stub = "" ;
221
222if ($own_type =~ /pl/oi) {
223    $own_stub = "perl "
224}
225
226if ($caps) { $afmpl = 0 } # for the moment
227
228# so we can use both combined
229
230if ($lcdf) {
231    $novirtual = 1 ;
232}
233
234if (!$novirtual) {
235    $virtual = 1 ;
236}
237
238# A couple of routines.
239
240sub report {
241    my $str = shift ;
242    $str =~ s/  / /goi ;
243    if ($str =~ /(.*?)\s+([\:\/])\s+(.*)/o) {
244        if ($1 eq "") {
245            $str = " " ;
246        } else {
247            $str = $2 ;
248        }
249        print sprintf("%22s $str %s\n",$1,$3) ;
250    }
251}
252
253sub error {
254    report("processing aborted : " . shift) ;
255    print "\n" ;
256    report "--help : show some more info" ;
257    exit ;
258}
259
260# The banner.
261
262print "\n" ;
263report ("TeXFont 2.2.1 - ConTeXt / PRAGMA ADE 2000-2004") ;
264print "\n" ;
265
266# Handy for scripts: one can provide a preferred path, if it
267# does not exist, the current path is taken.
268
269if (!(-d $sourcepath)&&($sourcepath ne 'auto')) { $sourcepath = "." }
270
271# Let's make multiple masters if requested.
272
273sub create_mm_font
274  { my ($name,$weight,$width) = @_ ; my $flag = my $args = my $tags = "" ;
275    my $ok ;
276    if ($name ne "")
277      { report ("mm source file : $name") }
278    else
279      { error ("missing mm source file") }
280    if ($weight ne "")
281      { report ("weight : $weight") ;
282        $flag .= " --weight=$weight " ;
283        $tags .= "-weight-$weight" }
284    if ($width ne "")
285      { report ("width : $width") ;
286        $flag .= " --width=$width " ;
287        $tags .= "-width-$width" }
288    error ("no specification given") if ($tags eq "") ;
289    error ("no amfm file found") unless (-f "$sourcepath/$name.amfm") ;
290    error ("no pfb file found") unless (-f "$sourcepath/$name.pfb") ;
291    $args = "$flag --precision=5 --kern-precision=0 --output=$sourcepath/$name$tags.afm" ;
292    my $command = "mmafm $args $sourcepath/$name.amfm" ;
293    print "$command\n" if $trace ;
294    $ok = `$command` ; chomp $ok ;
295    if ($ok ne "") { report ("warning $ok") }
296    $args = "$flag --precision=5 --output=$sourcepath/$name$tags.pfb" ;
297    $command = "mmpfb $args $sourcepath/$name.pfb" ;
298    print "$command\n" if $trace ;
299    $ok = `$command` ; chomp $ok ;
300    if ($ok ne "") { report ("warning $ok") }
301    report ("mm result file : $name$tags") }
302
303if (($weight ne "")||($width ne ""))
304  { create_mm_font($ARGV[0],$weight,$width) ;
305    exit }
306
307# go on
308
309if (($listing||$remove)&&($sourcepath eq "."))
310  { $sourcepath = "auto" }
311
312if ($fontroot eq "")
313  { if ($dosish)
314      { $fontroot = `kpsewhich -expand-path=\$$installpath` }
315    else
316      { $fontroot = `kpsewhich -expand-path=\\\$$installpath` }
317    chomp $fontroot }
318
319
320if ($fontroot =~ /\s+/)  # needed for windows, spaces in name
321  { $fontroot = &GetShortPathName($fontroot) } # but ugly when not needed
322
323if ($test)
324  { $vendor = $collection = "test" ;
325    $install = 1 }
326
327if (($spaced ne "") && ($spaced !~ /\d/)) { $spaced = "50" }
328if (($slant  ne "") && ($slant  !~ /\d/)) { $slant  = "0.167" }
329if (($extend ne "") && ($extend !~ /\d/)) { $extend = "1.200" }
330if (($narrow ne "") && ($narrow !~ /\d/)) { $narrow = "0.800" }
331if (($caps   ne "") && ($caps   !~ /\d/)) { $caps   = "0.800" }
332
333$encoding   = lc $encoding ;
334$vendor     = lc $vendor ;
335$collection = lc $collection ;
336
337if ($encoding =~ /default/oi) { $encoding = "texnansi" }
338
339my $lcfontroot = lc $fontroot ;
340
341# Auto search paths
342
343my @trees = split(/\,/,$trees) ;
344
345# Test for help asked.
346
347if ($help)
348  { report "--fontroot=path     : texmf destination font root (default: $lcfontroot)" ;
349    report "--rootlist=paths    : texmf source roots (default: $trees)" ;
350    report "--sourcepath=path   : when installing, copy from this path (default: $sourcepath)" ;
351    report "--sourcepath=auto   : locate and use vendor/collection" ;
352    print  "\n" ;
353    report "--vendor=name       : vendor name/directory" ;
354    report "--collection=name   : font collection" ;
355    report "--encoding=name     : encoding vector (default: $encoding)" ;
356    report "--variant=name      : encoding variant (.enc file or otftotfm features)" ;
357    print  "\n" ;
358    report "--spaced=s          : space glyphs in font by promille of em (0 - 1000)" ;
359    report "--slant=s           : slant glyphs in font by factor (0.0 - 1.5)" ;
360    report "--extend=s          : extend glyphs in font by factor (0.0 - 1.5)" ;
361    report "--caps=s            : capitalize lowercase chars by factor (0.5 - 1.0)" ;
362    report "--noligs --nofligs  : remove ligatures" ;
363    print  "\n" ;
364    report "--install           : copy files from source to font tree" ;
365    report "--listing           : list files on auto sourcepath" ;
366    report "--remove            : remove files on auto sourcepath" ;
367    report "--makepath          : when needed, create the paths" ;
368    print  "\n" ;
369    report "--test              : use test paths for vendor/collection" ;
370    report "--show              : run tex on texfont.tex" ;
371    print  "\n" ;
372    report "--batch             : process given batch file" ;
373    print  "\n" ;
374    report "--weight            : multiple master weight" ;
375    report "--width             : multiple master width" ;
376    print  "\n" ;
377    report "--expert            : also handle expert fonts" ;
378    print  "\n" ;
379    report "--afmpl             : use afm2pl instead of afm2tfm" ;
380    report "--preproc           : pre-process ttf/otf, converting them to pfb" ;
381    report "--lcdf              : use lcdf fonttools to create virtual encoding" ;
382    exit }
383
384if (($batch)||(($ARGV[0]) && ($ARGV[0] =~ /.+\.dat$/io)))
385  { my $batchfile = $ARGV[0] ;
386    unless (-f $batchfile)
387      { if ($batchfile !~ /\.dat$/io) { $batchfile .= ".dat" } }
388    unless (-f $batchfile)
389      { report ("trying to locate : $batchfile") ;
390        $batchfile = `kpsewhich -format="other text files" -progname=context $batchfile` ;
391        chomp $batchfile }
392    error ("unknown batch file $batchfile") unless -e $batchfile ;
393    report ("processing batch file : $batchfile") ;
394    my $select = (($vendor ne "")||($collection ne "")) ;
395    my $selecting = 0 ;
396    if (open(BAT, $batchfile))
397      { while ()
398          { chomp ;
399            s/(.+)\#.*/$1/o ;
400            next if (/^\s*$/io) ;
401            if ($select)
402              { if ($selecting)
403                  { if (/^\s*[\#\%]/io) { if (!/\-\-/o) { last } else { next } } }
404                elsif ((/^\s*[\#\%]/io)&&(/$vendor/i)&&(/$collection/i))
405                  { $selecting = 1 ; next }
406                else
407                  { next } }
408            else
409              { next if (/^\s*[\#\%]/io) ;
410                next unless (/\-\-/oi) }
411                s/\s+/ /gio ;
412                s/(--en.*\=)\?/$1$encoding/io ;
413                report ("batch line : $_") ;
414              # system ("perl $0 --fontroot=$fontroot $_") }
415	        my $own_quote = ( $own_path =~ m/^[^\"].* / ? "\"" : "" );
416            my $switches = '' ;
417            $switches .= "--afmpl " if $afmpl ;
418            system ("$own_stub$own_quote$own_path$own_name$own_type$own_quote $switches --fontroot=$fontroot $_") }
419            close (BAT) }
420    exit }
421
422error ("unknown vendor     $vendor")     unless    $vendor ;
423error ("unknown collection $collection") unless    $collection ;
424error ("unknown tex root   $lcfontroot") unless -d $fontroot ;
425
426my $varlabel = $variant ;
427
428if ($lcdf)
429  { $varlabel =~ s/,/-/goi ;
430    $varlabel =~ tr/a-z/A-Z/ }
431
432if ($varlabel ne "")
433  { $varlabel = "-$varlabel" }
434
435my $identifier = "$encoding$varlabel-$vendor-$collection" ;
436
437my $outlinepath = $sourcepath ; my $path = "" ;
438
439my $shape = "" ;
440
441if ($noligs||$nofligs)
442  { report ("ligatures : removed") ;
443    $fontsuffix .= "-unligatured" ;
444    $namesuffix .= "-NoLigs" }
445
446if ($caps ne "")
447  {    if ($caps <0.5) { $caps = 0.5 }
448    elsif ($caps >1.0) { $caps = 1.0 }
449    $shape .= " -c $caps " ;
450    report ("caps factor : $caps") ;
451    $fontsuffix .= "-capitalized-" . int(1000*$caps)  ;
452    $namesuffix .= "-Caps" }
453
454if ($extend ne "")
455  { if    ($extend<0.0) { $extend = 0.0 }
456    elsif ($extend>1.5) { $extend = 1.5 }
457    report ("extend factor : $extend") ;
458    if ($lcdf)
459      { $shape .= " -E $extend " }
460    else
461      { $shape .= " -e $extend " }
462    $fontsuffix .= "-extended-" . int(1000*$extend) ;
463    $namesuffix .= "-Extended" }
464
465if ($narrow ne "") # goodie
466  { $extend = $narrow ;
467    if    ($extend<0.0) { $extend = 0.0 }
468    elsif ($extend>1.5) { $extend = 1.5 }
469    report ("narrow factor : $extend") ;
470    if ($lcdf)
471      { $shape .= " -E $extend " }
472    else
473      { $shape .= " -e $extend " }
474    $fontsuffix .= "-narrowed-" . int(1000*$extend) ;
475    $namesuffix .= "-Narrowed" }
476
477if ($slant ne "")
478  {    if ($slant <0.0) { $slant = 0.0 }
479    elsif ($slant >1.5) { $slant = 1.5 }
480    report ("slant factor : $slant") ;
481    if ($lcdf)
482      { $shape .= " -S $slant " }
483    else
484      { $shape .= " -s $slant " }
485    $fontsuffix .= "-slanted-" . int(1000*$slant) ;
486    $namesuffix .= "-Slanted" }
487
488if ($spaced ne "")
489  {    if ($spaced <   0) { $spaced =    0 }
490    elsif ($spaced >1000) { $spaced = 1000 }
491    report ("space factor : $spaced") ;
492    if ($lcdf)
493      { $shape .= " -L $spaced " }
494    else
495      { $shape .= " -m $spaced " }
496    $fontsuffix .= "-spaced-" . $spaced ;
497    $namesuffix .= "-Spaced" }
498
499if ($sourcepath eq "auto") # todo uppercase root
500  { foreach my $root (@trees)
501      { if ($dosish)
502          { $path = `kpsewhich -expand-path=\$$root` }
503        else
504          { $path = `kpsewhich -expand-path=\\\$$root` }
505        chomp $path ;
506        $path = $ENV{$root} if (($path eq '') && defined($ENV{$root})) ;
507        report ("checking root : $root") ;
508        if ($preproc)
509          { $sourcepath = "$path/fonts/truetype/$vendor/$collection" }
510        else
511          { $sourcepath = "$path/fonts/afm/$vendor/$collection" }
512        unless (-d $sourcepath)
513          { my $ven = $vendor ; $ven =~ s/(........).*/$1/ ;
514            my $col = $collection ; $col =~ s/(........).*/$1/ ;
515            $sourcepath = "$path/fonts/afm/$ven/$col" ;
516            if (-d $sourcepath)
517              { $vendor = $ven ; $collection = $col } }
518        $outlinepath = "$path/fonts/type1/$vendor/$collection" ;
519        if (-d $sourcepath)
520          { # $install = 0 ;  # no copy needed
521            $makepath = 1 ; # make on local if needed
522	    my @files = validglob("$sourcepath/*.afm") ;
523	    if ($preproc)
524	      { @files = validglob("$sourcepath/*.otf") ;
525	        report("locating : otf files") }
526	    unless (@files)
527          { @files = validglob("$sourcepath/*.ttf") ;
528	        report("locating : ttf files") }
529        if (@files)
530          { if ($listing)
531              { report ("fontpath : $sourcepath" ) ;
532                print "\n" ;
533                foreach my $file (@files)
534                  { if (open(AFM,$file))
535                      { my $name = "unknown name" ;
536                        while ()
537                          { chomp ;
538                            if (/^fontname\s+(.*?)$/oi)
539                              { $name = $1 ; last } }
540                        close (AFM) ;
541                        if ($preproc)
542                          { $file =~ s/.*\/(.*)\..tf/$1/io }
543                        else
544                          { $file =~ s/.*\/(.*)\.afm/$1/io }
545                        report ("$file : $name") } }
546                exit }
547            elsif ($remove)
548              { error ("no removal from : $root") if ($root eq 'TEXMFMAIN') ;
549                foreach my $file (@files)
550                  { if ($preproc)
551                      { $file =~ s/.*\/(.*)\..tf/$1/io }
552                    else
553                      { $file =~ s/.*\/(.*)\.afm/$1/io }
554                    foreach my $sub ("tfm","vf")
555                      { foreach my $typ ("","-raw")
556                          { my $nam = "$path/fonts/$sub/$vendor/$collection/$encoding$varlabel$typ-$file.$sub" ;
557                            if (-s $nam)
558                              { report ("removing : $encoding$varlabel$typ-$file.$sub") ;
559                                unlink $nam } } } }
560                my $nam = "$encoding$varlabel-$vendor-$collection.tex" ;
561                if (-e $nam)
562                  { report ("removing : $nam") ;
563                    unlink "$nam" }
564                my $mapfile = "$encoding$varlabel-$vendor-$collection" ;
565                foreach my $map ("pdftex","dvips", "dvipdfm")
566                  { my $maproot = "$fontroot/fonts/map/$map/context/";
567                    if (-e "$maproot$mapfile.map")
568                       { report ("renaming : $mapfile.map -> $mapfile.bak") ;
569                         unlink "$maproot$mapfile.bak" ;
570                         rename "$maproot$mapfile.map", "$maproot$mapfile.bak" } }
571                exit }
572            else
573              { last } } } }
574    error ("unknown subpath ../fonts/afm/$vendor/$collection") unless -d $sourcepath }
575
576error ("unknown source path $sourcepath") unless -d $sourcepath ;
577error ("unknown option $ARGV[0]")         if (($ARGV[0]||'') =~ /\-\-/) ;
578
579my $afmpath = "$fontroot/fonts/afm/$vendor/$collection" ;
580my $tfmpath = "$fontroot/fonts/tfm/$vendor/$collection" ;
581my $vfpath  = "$fontroot/fonts/vf/$vendor/$collection" ;
582my $pfbpath = "$fontroot/fonts/type1/$vendor/$collection" ;
583my $ttfpath = "$fontroot/fonts/truetype/$vendor/$collection" ;
584my $otfpath = "$fontroot/fonts/opentype/$vendor/$collection" ;
585my $encpath = "$fontroot/fonts/enc/dvips/context" ;
586
587sub mappath
588  { my $str = shift ;
589    return "$fontroot/fonts/map/$str/context" }
590
591# are not on local path ! ! ! !
592
593foreach my $path ($afmpath, $pfbpath)
594  { my @gzipped = <$path/*.gz> ;
595    foreach my $file (@gzipped)
596      { print "file = $file\n";
597	system ("gzip -d $file") } }
598
599# For gerben, we only generate a new database when an lsr file is present but for
600# myself we force this when texmf-fonts is used (else I get compatibility problems).
601
602if (($fontroot =~ /texmf\-fonts/o) || (-e "$fontroot/ls-R") || (-e "$fontroot/ls-r") || (-e "$fontroot/LS-R")) {
603    system ("mktexlsr $fontroot") ;
604}
605
606sub do_make_path
607  { my $str = shift ;
608    if ($str =~ /^(.*)\/.*?$/)
609      { do_make_path($1); }
610    mkdir $str, 0755 unless -d $str }
611
612sub make_path
613  { my $str = shift ;
614    do_make_path("$fontroot/fonts/$str/$vendor/$collection") }
615
616if ($makepath&&$install)
617  { make_path ("afm") ; make_path ("type1") }
618
619do_make_path(mappath("pdftex")) ;
620do_make_path(mappath("dvips")) ;
621do_make_path(mappath("dvipdfm")) ;
622do_make_path($encpath) ;
623
624# now fonts/map and fonts/enc
625
626make_path ("vf") ;
627make_path ("tfm") ;
628
629if ($install)
630  { error ("unknown afm path $afmpath") unless -d $afmpath ;
631    error ("unknown pfb path $pfbpath") unless -d $pfbpath }
632
633error ("unknown tfm path $tfmpath") unless -d $tfmpath ;
634error ("unknown vf  path $vfpath" ) unless -d $vfpath  ;
635error ("unknown map path " . mappath("pdftex"))  unless -d mappath("pdftex");
636error ("unknown map path " . mappath("dvips"))   unless -d mappath("dvips");
637error ("unknown map path " . mappath("dvipdfm")) unless -d mappath("dvipdfm");
638
639my $mapfile = "$identifier.map" ;
640my $bakfile = "$identifier.bak" ;
641my $texfile = "$identifier.tex" ;
642
643                report "encoding vector : $encoding" ;
644if ($variant) { report "encoding variant : $variant" }
645                report      "vendor name : $vendor" ;
646                report  "    source path : $sourcepath" ;
647                report  "font collection : $collection" ;
648                report  "texmf font root : $lcfontroot" ;
649                report  "  map file name : $mapfile" ;
650
651if ($install) { report "source path : $sourcepath" }
652
653my $fntlist = "" ;
654
655my $runpath = $sourcepath ;
656
657my @files ;
658
659sub UnLink
660  { foreach my $f (@_)
661     { if (unlink $f)
662          { report "deleted : $f" if $trace } } }
663
664sub globafmfiles
665  { my ($runpath, $pattern)  = @_ ;
666    my @files = validglob("$runpath/$pattern.afm") ;
667    report("locating afm files : using pattern $runpath/$pattern.afm");
668    if ($preproc && !$lcdf)
669      { @files = validglob("$runpath/$pattern.*tf") ;
670        report("locating otf files : using pattern $runpath/$pattern.*tf");
671        unless (@files)
672          { @files = validglob("$sourcepath/$pattern.ttf") ;
673	        report("locating ttf files : using pattern $sourcepath/$pattern.ttf") }
674          }
675    if (@files) # also elsewhere
676      { report("locating afm files : using pattern $pattern") }
677    else
678      { @files = validglob("$runpath/$pattern.ttf") ;
679        if (@files)
680          { report("locating afm files : using ttf files") ;
681            $extension = "ttf" ;
682            foreach my $file (@files)
683                   { $file =~ s/\.ttf$//io ;
684                     report ("generating afm file : $file.afm") ;
685                     my $command = "ttf2afm \"$file.ttf\" -o \"$file.afm\"" ;
686                     system($command) ;
687                     print "$command\n" if $trace ;
688                     push(@cleanup, "$file.afm") }
689            @files = validglob("$runpath/$pattern.afm") }
690        else # try doing the pre-processing earlier
691          { report("locating afm files : using otf files") ;
692            $extension = "otf" ;
693            @files = validglob("$runpath/$pattern.otf") ;
694            foreach my $file (@files)
695              { $file =~ s/\.otf$//io ;
696            if (!$lcdf)
697            { report ("generating afm file : $file.afm") ;
698              preprocess_font("$file.otf", "$file.bdf") ;
699              push(@cleanup,"$file.afm") }
700            if ($preproc)
701            { my $command = "cfftot1 --output=$file.pfb $file.otf" ;
702                      print "$command\n" if $trace ;
703              report("converting : $file.otf to $file.pfb") ;
704                      system($command) ;
705                      push(@cleanup, "$file.pfb") ;
706                }
707              }
708                if ($lcdf)
709            { @files = validglob("$runpath/$pattern.otf") }
710            else
711            { @files = validglob("$runpath/$pattern.afm") }
712          }
713       }
714    return @files }
715
716if ($pattern eq '') { if ($ARGV[0]) { $pattern = $ARGV[0] } }
717
718if ($pattern ne '')
719  { report ("processing files : all in pattern $pattern") ;
720    @files = globafmfiles($runpath,$pattern) }
721elsif ("$extend$narrow$slant$spaced$caps" ne "")
722  { error ("transformation needs file spec") }
723else
724  { $pattern = "*" ;
725    report ("processing files : all on afm path") ;
726    @files = globafmfiles($runpath,$pattern) }
727
728sub copy_files
729  { my ($suffix,$sourcepath,$topath) = @_ ;
730    my @files = validglob("$sourcepath/$pattern.$suffix") ;
731    return if ($topath eq $sourcepath) ;
732    report ("copying files : $suffix") ;
733    foreach my $file (@files)
734      { my $ok = $file =~ /(.*)\/(.+?)\.(.*)/ ;
735        my ($path,$name,$suffix) = ($1,$2,$3) ;
736        UnLink "$topath/$name.$suffix" ;
737        report ("copying : $name.$suffix") ;
738        copy ($file,"$topath/$name.$suffix") } }
739
740if ($install)
741  { copy_files("afm",$sourcepath,$afmpath) ;
742#   copy_files("tfm",$sourcepath,$tfmpath) ; # raw supplied names
743    copy_files("pfb",$outlinepath,$pfbpath) ;
744    if ($extension eq "ttf")
745      { make_path("truetype") ;
746        copy_files("ttf",$sourcepath,$ttfpath) }
747    if ($extension eq "otf")
748      { make_path("truetype") ;
749	    copy_files("otf",$sourcepath,$ttfpath) } }
750
751error ("no afm files found") unless @files ;
752
753sub open_mapfile
754  { my $type = shift;
755	my $mappath = mappath($type);
756    my $mapdata = "";
757	my $mapptr = undef;
758	my $fullmapfile = $mapfile;
759	$fullmapfile = "$type-$fullmapfile" unless $type eq "pdftex";
760	if ($install)
761	  { copy ("$mappath/$mapfile","$mappath/$bakfile") ; }
762    if (open ($mapptr,"<$mappath/$mapfile"))
763      { report ("extending map file : $mappath/$mapfile") ;
764        while (<$mapptr>) { unless (/^\%/o) { $mapdata .= $_ } }
765        close ($mapptr) }
766    else
767      { report ("no map file at : $mappath/$mapfile") }
768    #~ unless (open ($mapptr,">$fullmapfile") )
769do_make_path($mappath) ;
770    unless (open ($mapptr,">$mappath/$fullmapfile") )
771      { report "warning : can't open $fullmapfile" }
772    else
773      { if ($type eq "pdftex")
774          { print $mapptr "% This file is generated by the TeXFont Perl script.\n";
775            print $mapptr "%\n" ;
776            print $mapptr "% You need to add the following line to your file:\n" ;
777            print $mapptr "%\n" ;
778            print $mapptr "%   \\pdfmapfile{+$mapfile}\n" ;
779            print $mapptr "%\n" ;
780            print $mapptr "% In ConTeXt you can best use:\n" ;
781            print $mapptr "%\n" ;
782            print $mapptr "%   \\loadmapfile\[$mapfile\]\n\n" } }
783    return ($mapptr,$mapdata) ; }
784
785sub finish_mapfile
786  { my ($type, $mapptr, $mapdata ) = @_;
787	my $fullmapfile = $mapfile;
788	$fullmapfile = "$type-$fullmapfile" unless $type eq "pdftex";
789    if (defined $mapptr)
790      { report ("updating map file : $mapfile (for $type)") ;
791        while ($mapdata =~ s/\n\n+/\n/mois) {} ;
792        $mapdata =~ s/^\s*//gmois ;
793        print $mapptr $mapdata ;
794        close ($mapptr) ;
795        if ($install)
796          { copy ("$fullmapfile", mappath($type) . "/$mapfile") ; } } }
797
798
799my ($PDFTEXMAP,$pdftexmapdata)   = open_mapfile("pdftex");
800my ($DVIPSMAP,$dvipsmapdata)     = open_mapfile("dvips");
801my ($DVIPDFMMAP,$dvipdfmmapdata) = open_mapfile("dvipdfm");
802
803my $tex = 0 ;
804my $texdata = "" ;
805
806if (open (TEX,"<$texfile"))
807  { while () { unless (/stoptext/o) { $texdata .= $_ } }
808    close (TEX) }
809
810$tex = open (TEX,">$texfile") ;
811
812unless ($tex) { report "warning : can't open $texfile" }
813
814if ($tex)
815  { if ($texdata eq "")
816      { print TEX "% interface=en\n" ;
817        print TEX "\n" ;
818        print TEX "\\usemodule[fnt-01]\n" ;
819        print TEX "\n" ;
820        print TEX "\\loadmapfile[$mapfile]\n" ;
821        print TEX "\n" ;
822        print TEX "\\starttext\n\n" }
823    else
824      { print TEX "$texdata" ;
825        print TEX "\n\%appended section\n\n\\page\n\n" } }
826
827sub removeligatures
828  { my $filename = shift ; my $skip = 0 ;
829    copy ("$filename.vpl","$filename.tmp") ;
830    if ((open(TMP,"<$filename.tmp"))&&(open(VPL,">$filename.vpl")))
831      { report "removing ligatures : $filename" ;
832        while ()
833         { chomp ;
834           if ($skip)
835             { if (/^\s*\)\s*$/o) { $skip = 0 ; print VPL "$_\n" } }
836           elsif (/\(LIGTABLE/o)
837             { $skip = 1 ; print VPL "$_\n" }
838           else
839             { print VPL "$_\n" } }
840        close(TMP) ; close(VPL) }
841    UnLink ("$filename.tmp") }
842
843my $raw = my $use = my $maplist = my $texlist = my $report = "" ;
844
845$use = "$encoding$varlabel-" ; $raw = $use . "raw-" ;
846
847my $encfil = "" ;
848
849if ($encoding ne "") # evt -progname=context
850  { $encfil = `kpsewhich -progname=pdftex $encoding$varlabel.enc` ;
851    chomp $encfil ; if ($encfil eq "") { $encfil = "$encoding$varlabel.enc" } }
852
853sub build_pdftex_mapline
854  { my ($option, $usename, $fontname, $rawname, $cleanfont, $encoding, $varlabel, $strange)  = @_;
855    my $cleanname = $fontname;
856	$cleanname =~ s/\_//gio ;
857    $option =~ s/^\s+(.*)/$1/o ;
858    $option =~ s/(.*)\s+$/$1/o ;
859    $option =~ s/  / /g ;
860    if ($option ne "")
861      { $option = "\"$option\" 4" }
862    else
863      { $option = "4" }
864    # adding cleanfont is kind of dangerous
865    my $thename = "";
866	my $str = "";
867    my $theencoding = "" ;
868    if ($strange ne "")
869      { $thename = $cleanname ; $theencoding = "" ; }
870    elsif ($lcdf)
871      { $thename = $usename ; $theencoding = " $encoding$varlabel-$cleanname.enc" }
872    elsif ($afmpl)
873      { $thename = $usename ; $theencoding = " $encoding$varlabel.enc" }
874    elsif ($virtual)
875      { $thename = $rawname ; $theencoding = " $encoding$varlabel.enc" }
876    else
877      { $thename = $usename ; $theencoding = " $encoding$varlabel.enc" }
878if ($uselmencodings) {
879    $theencoding =~ s/^(ec)\.enc/lm\-$1.enc/ ;
880}
881    # quit rest if no type 1 file
882    my $pfb_sourcepath = $sourcepath ;
883    $pfb_sourcepath =~ s@/afm/@/type1/@ ;
884    unless ((-e "$pfbpath/$fontname.$extension")||
885			(-e "$pfb_sourcepath/$fontname.$extension")||
886			(-e "$sourcepath/$fontname.$extension")||
887			(-e "$ttfpath/$fontname.$extension"))
888	  { if ($tex) { $report .= "missing file: \\type \{$fontname.pfb\}\n" }
889		report ("missing pfb file : $fontname.pfb") }
890    # now add entry to map
891    if ($strange eq "") {
892	  if ($extension eq "otf") {
893		if ($lcdf) {
894		  my $mapline = "" ;
895		  if (open(ALTMAP,"texfont.map")) {
896			while () {
897			  chomp ;
898			  # atl: we assume this b/c we always force otftotfm --no-type1
899			  if (/<<(.*)\.otf$/oi) {
900				$mapline = $_ ; last ;
901			  }
902			}
903			close(ALTMAP) ;
904		  } else {
905			report("no mapfile from otftotfm : texfont.map") ;
906		  }
907		  if ($preproc) {
908			$mapline =~ s/<\[/909			$mapline =~ s/<<(\S+)\.otf$/<$1\.pfb/ ;
910		  } else {
911			$mapline =~ s/<<(\S+)\.otf$/<< $ttfpath\/$fontname.$extension/ ;
912		  }
913		  $str = "$mapline\n" ;
914		} else {
915		  if ($preproc) {
916			$str = "$thename $cleanfont $option < $fontname.pfb$theencoding\n" ;
917		  } else {
918			# PdfTeX can't subset OTF files, so we have to include the whole thing
919			# It looks like we also need to be explicit on where to find the file
920			$str = "$thename $cleanfont $option << $ttfpath/$fontname.$extension <$theencoding\n" ;
921		  }
922		}
923	  } else {
924		$str = "$thename $cleanfont $option < $fontname.$extension$theencoding\n" ;
925	  }
926    } else {
927	  $str = "$thename $cleanfont < $fontname.$extension\n" ;
928    }
929    return ($str, $thename); }
930
931sub build_dvips_mapline
932  { my ($option, $usename, $fontname, $rawname, $cleanfont, $encoding, $varlabel, $strange)  = @_;
933    my $cleanname = $fontname;
934	$cleanname =~ s/\_//gio ;
935    $option =~ s/^\s+(.*)/$1/o ;
936    $option =~ s/(.*)\s+$/$1/o ;
937    $option =~ s/  / /g ;
938    # adding cleanfont is kind of dangerous
939    my $thename = "";
940	my $str = "";
941    my $optionencoding = "" ;
942	my $encname = "";
943    my $theencoding = "" ;
944	if ($encoding ne "") # evt -progname=context
945	  { $encfil = `kpsewhich -progname=dvips $encoding$varlabel.enc` ;
946		chomp $encfil ;
947		if ($encfil eq "")
948         { $encfil = "$encoding$varlabel.enc" ; }
949		if (open(ENC,"<$encfil"))
950		  { while ()
951			{ if (/^\/([^ ]+)\s*\[/)
952              { $encname = $1;
953                last; } }
954			close ENC; } }
955    if ($strange ne "")
956      { $thename = $cleanname ;
957		$optionencoding = "\"$option\""  if length($option)>1; }
958    elsif ($lcdf)
959      { $thename = $usename ;
960		$optionencoding = "\"$option $encname ReEncodeFont\" <$encoding$varlabel-$cleanname.enc" }
961    elsif ($afmpl)
962      { $thename = $usename ;
963		$optionencoding = "\"$option $encname ReEncodeFont\" <$encoding$varlabel.enc" }
964    elsif ($virtual)
965      { $thename = $rawname ;
966		$optionencoding = "\"$option $encname ReEncodeFont\" <$encoding$varlabel.enc" }
967    else
968      { $thename = $usename ;
969		$optionencoding = "\"$option $encname ReEncodeFont\" <$encoding$varlabel.enc" }
970if ($uselmencodings) {
971    $theencoding =~ s/^(ec)\.enc/lm\-$1.enc/ ;
972}
973    # quit rest if no type 1 file
974    my $pfb_sourcepath = $sourcepath ;
975    $pfb_sourcepath =~ s@/afm/@/type1/@ ;
976    unless ((-e "$pfbpath/$fontname.$extension")||
977			(-e "$pfb_sourcepath/$fontname.$extension")||
978			(-e "$sourcepath/$fontname.$extension")||
979			(-e "$ttfpath/$fontname.$extension"))
980	  { if ($tex) { $report .= "missing file: \\type \{$fontname.pfb\}\n" }
981       report ("missing pfb file : $fontname.pfb") }
982    # now add entry to map
983    if ($strange eq "") {
984	  if ($extension eq "otf") {
985		if ($lcdf) {
986		  my $mapline = "" ;
987		  if (open(ALTMAP,"texfont.map")) {
988			while () {
989			  chomp ;
990			  # atl: we assume this b/c we always force otftotfm --no-type1
991			  if (/<<(.*)\.otf$/oi) {
992				$mapline = $_ ; last ;
993			  }
994			}
995			close(ALTMAP) ;
996		  } else {
997			report("no mapfile from otftotfm : texfont.map") ;
998		  }
999		  if ($preproc) {
1000			$mapline =~ s/<\[/1001			$mapline =~ s/<<(\S+)\.otf$/<$1\.pfb/ ;
1002		  } else {
1003			$mapline =~ s/<<(\S+)\.otf$/<< $ttfpath\/$fontname.$extension/ ;
1004		  }
1005		  $str = "$mapline\n" ;
1006		} else {
1007		  if ($preproc) {
1008			$str = "$thename $cleanfont $optionencoding <$fontname.pfb\n" ;
1009		  } else {
1010			# dvips can't subset OTF files, so we have to include the whole thing
1011			# It looks like we also need to be explicit on where to find the file
1012			$str = "$thename $cleanfont $optionencoding << $ttfpath/$fontname.$extension \n" ;
1013		  }
1014		}
1015	  } else {
1016		$str = "$thename $cleanfont $optionencoding <$fontname.$extension\n" ;
1017	  }
1018	} else {
1019	  $str = "$thename $cleanfont $optionencoding <$fontname.$extension\n" ;
1020	}
1021    return ($str, $thename); }
1022#	return $str; }
1023
1024
1025sub build_dvipdfm_mapline
1026  { my ($option, $usename, $fontname, $rawname, $cleanfont, $encoding, $varlabel, $strange)  = @_;
1027    my $cleanname = $fontname;
1028	$cleanname =~ s/\_//gio ;
1029	$option =~ s/([\d\.]+)\s+SlantFont/ -s $1 /;
1030	$option =~ s/([\d\.]+)\s+ExtendFont/ -e $1 /;
1031    $option =~ s/^\s+(.*)/$1/o ;
1032    $option =~ s/(.*)\s+$/$1/o ;
1033    $option =~ s/  / /g ;
1034    # adding cleanfont is kind of dangerous
1035    my $thename = "";
1036	my $str = "";
1037    my $theencoding = "" ;
1038    if ($strange ne "")
1039      { $thename = $cleanname ; $theencoding = "" ; }
1040    elsif ($lcdf)
1041      { $thename = $usename ; $theencoding = " $encoding$varlabel-$cleanname" }
1042    elsif ($afmpl)
1043      { $thename = $usename ; $theencoding = " $encoding$varlabel" }
1044    elsif ($virtual)
1045      { $thename = $rawname ; $theencoding = " $encoding$varlabel" }
1046    else
1047      { $thename = $usename ; $theencoding = " $encoding$varlabel" }
1048if ($uselmencodings) {
1049    $theencoding =~ s/^(ec)\.enc/lm\-$1.enc/ ;
1050}
1051    # quit rest if no type 1 file
1052    my $pfb_sourcepath = $sourcepath ;
1053    $pfb_sourcepath =~ s@/afm/@/type1/@ ;
1054    unless ((-e "$pfbpath/$fontname.$extension")||
1055			(-e "$pfb_sourcepath/$fontname.$extension")||
1056			(-e "$sourcepath/$fontname.$extension")||
1057			(-e "$ttfpath/$fontname.$extension"))
1058	  { if ($tex) { $report .= "missing file: \\type \{$fontname.pfb\}\n" }
1059		report ("missing pfb file : $fontname.pfb") }
1060    # now add entry to map
1061    if ($strange eq "") {
1062	  if ($extension eq "otf") {
1063		#TH: todo
1064	  } else {
1065		$str = "$thename $theencoding $fontname $option\n" ;
1066	  }
1067	} else {
1068	  $str = "$thename $fontname $option\n" ;
1069	}
1070    return ($str, $thename); }
1071#	return $str; }
1072
1073
1074sub preprocess_font
1075  { my ($infont,$pfbfont) = @_ ;
1076    if ($infont ne "")
1077      { report ("otf/ttf source file : $infont") ;
1078        report ("destination file : $pfbfont") ; }
1079    else
1080      { error ("missing otf/ttf source file") }
1081    open (CONVERT, "| pfaedit -script -") || error ("couldn't open pipe to pfaedit") ;
1082    report ("pre-processing with : pfaedit") ;
1083    print CONVERT "Open('$infont');\n Generate('$pfbfont', '', 1) ;\n" ;
1084    close (CONVERT) }
1085
1086foreach my $file (@files)
1087  { my $option = my $slant = my $spaced = my $extend = my $vfstr = my $encstr = "" ;
1088    my $strange = "" ; my ($rawfont,$cleanfont,$restfont) ;
1089    $file = $file ;
1090    my $ok = $file =~ /(.*)\/(.+?)\.(.*)/ ;
1091    my ($path,$name,$suffix) = ($1,$2,$3) ;
1092    # remove trailing _'s
1093    my $fontname = $name ;
1094    my $cleanname = $fontname ;
1095    $cleanname =~ s/\_//gio ;
1096    # atl: pre-process an opentype or truetype file by converting to pfb
1097    if ($preproc && !$lcdf)
1098      { unless (-f "$afmpath/$cleanname.afm" && -f "$pfbpath/$cleanname.pfb")
1099          { preprocess_font("$path/$name.$suffix", "$pfbpath/$cleanname.pfb") ;
1100            rename("$pfbpath/$cleanname.afm", "$afmpath/$cleanname.afm")
1101	      || error("couldn't move afm product of pre-process.") }
1102        $path = $afmpath ;
1103        $file = "$afmpath/$cleanname.afm" }
1104    # cleanup
1105    foreach my $suf ("tfm", "vf", "vpl")
1106      { UnLink "$raw$cleanname$fontsuffix.$suf" ;
1107        UnLink "$use$cleanname$fontsuffix.$suf" }
1108    UnLink "texfont.log" ;
1109    # set switches
1110    if ($encoding ne "")
1111      { $encstr = " -T $encfil" }
1112    if ($caps ne "")
1113      { $vfstr = " -V $use$cleanname$fontsuffix" }
1114    else # if ($virtual)
1115      { $vfstr = " -v $use$cleanname$fontsuffix" }
1116    my $font = "";
1117    # let's see what we have here (we force texnansi.enc to avoid error messages)
1118    if ($lcdf)
1119      { my $command = "otfinfo -p $file" ;
1120        print "$command\n" if $trace;
1121        $font = `$command` ;
1122        chomp $font ;
1123        $cleanname = $cleanfont = $font }
1124    else
1125      { my $command = "afm2tfm \"$file\" -p texnansi.enc texfont.tfm" ;
1126        print "$command (for testing)\n" if $trace ;
1127        $font = `$command` ;
1128        UnLink "texfont.tfm" ;
1129        ($rawfont,$cleanfont,$restfont) = split(/\s/,$font) }
1130    if ($font =~ /(math|expert)/io) { $strange = lc $1 }
1131    $cleanfont =~ s/\_/\-/goi ;
1132    $cleanfont =~ s/\-+$//goi ;
1133    print "\n" ;
1134    if (($strange eq "expert")&&($expert))
1135      { report ("font identifier : $cleanfont$namesuffix -> $strange -> tfm") }
1136    elsif ($strange ne "")
1137      { report ("font identifier : $cleanfont$namesuffix -> $strange -> skipping") }
1138    elsif ($afmpl)
1139      { report ("font identifier : $cleanfont$namesuffix -> text -> tfm") }
1140    elsif ($virtual)
1141      { report ("font identifier : $cleanfont$namesuffix -> text -> tfm + vf") }
1142    else
1143      { report ("font identifier : $cleanfont$namesuffix -> text -> tfm") }
1144    # don't handle strange fonts
1145    if ($strange eq "")
1146      { # atl: support for lcdf otftotfm
1147        if ($lcdf && $extension eq "otf")
1148          { # no vf, bypass afm, use otftotfm to get encoding and tfm
1149            my $varstr = my $encout = my $tfmout = "" ;
1150            report "processing files : otf -> tfm + enc" ;
1151            if ($encoding ne "")
1152              { $encfil = `kpsewhich -progname=pdftex $encoding.enc` ;
1153                chomp $encfil ; if ($encfil eq "") { $encfil = "$encoding.enc" }
1154                $encstr = " -e $encfil " }
1155            if ($variant ne "")
1156              { ( $varstr = $variant ) =~ s/,/ -f /goi ;
1157                $varstr = " -f $varstr" }
1158            $encout = "$encpath/$use$cleanfont.enc" ;
1159            if (-e $encout)
1160              { report ("renaming : $encout -> $use$cleanfont.bak") ;
1161                UnLink "$encpath/$use$cleanfont.bak" ;
1162                rename $encout, "$encpath/$use$cleanfont.bak" }
1163    	    UnLink "texfont.map" ;
1164            $tfmout = "$use$cleanfont$fontsuffix" ;
1165            my $otfcommand = "otftotfm -a $varstr $encstr $passon $shape --name=\"$tfmout\" --encoding-dir=\"$encpath/\" --tfm-dir=\"$tfmpath/\" --vf-dir=\"$vfpath/\" --no-type1 --map-file=./texfont.map \"$file\"" ;
1166            print "$otfcommand\n"  if $trace ;
1167            system("$otfcommand") ;
1168            $encfil = $encout }
1169        else
1170          { # generate tfm and vpl, $file is on afm path
1171            my $font = '' ;
1172            if ($afmpl)
1173              { report "         generating pl : $cleanname$fontsuffix (from $cleanname)" ;
1174                $encstr = " -p $encfil" ;
1175                if ($uselmencodings) {
1176                    $encstr =~ s/(ec)\.enc$/lm\-$1\.enc/ ;
1177                }
1178                my $command = "afm2pl -f afm2tfm $shape $passon $encstr $file $cleanname$fontsuffix.vpl" ;
1179                print "$command\n" if $trace ;
1180                my $ok = `$command` ;
1181                if (open (TMP,"$cleanname$fontsuffix.map"))
1182                   { $font =  ;
1183                     close(TMP) ;
1184                     UnLink "$cleanname$fontsuffix.map" } }
1185            else
1186              { report "generating raw tfm/vpl : $raw$cleanname$fontsuffix (from $cleanname)" ;
1187                my $command = "afm2tfm $file $shape $passon $encstr $vfstr $raw$cleanname$fontsuffix" ;
1188                print "$command\n" if $trace ;
1189                $font = `$command` }
1190			# generate vf file if needed
1191			chomp $font ;
1192			if ($font =~ /.*?([\d\.]+)\s*ExtendFont/io) { $extend = $1 }
1193			if ($font =~ /.*?([\d\.]+)\s*SlantFont/io)  { $slant  = $1 }
1194			if ($extend ne "") { $option .= " $extend ExtendFont " }
1195			if ($slant ne "")  { $option .= " $slant SlantFont " }
1196			if ($afmpl)
1197			  { if ($noligs||$nofligs) { removeligatures("$cleanname$fontsuffix") }
1198                report "generating new tfm : $use$cleanname$fontsuffix" ;
1199				my $command = "pltotf $cleanname$fontsuffix.vpl $use$cleanname$fontsuffix.tfm" ;
1200				print "$command\n" if $trace ;
1201				my $ok = `$command` }
1202			elsif ($virtual)
1203			  { if ($noligs||$nofligs) { removeligatures("$use$cleanname$fontsuffix") }
1204                report "generating new vf : $use$cleanname$fontsuffix (from $use$cleanname)" ;
1205				my $command = "vptovf $use$cleanname$fontsuffix.vpl $use$cleanname$fontsuffix.vf $use$cleanname$fontsuffix.tfm" ;
1206				print "$command\n" if $trace ;
1207				my $ok = `$command` }
1208			else
1209			  { if ($noligs||$nofligs) { removeligatures("$raw$cleanname$fontsuffix") }
1210                report "generating new tfm : $use$cleanname$fontsuffix (from $raw$cleanname)" ;
1211				my $command = "pltotf $raw$cleanname$fontsuffix.vpl $use$cleanname$fontsuffix.tfm" ;
1212				print "$command\n" if $trace ;
1213				my $ok = `$command` } } }
1214    elsif (-e "$sourcepath/$cleanname.tfm" )
1215      { report "using existing tfm : $cleanname.tfm" }
1216    elsif (($strange eq "expert")&&($expert))
1217      { report "creating tfm file : $cleanname.tfm" ;
1218        my $command = "afm2tfm $file $cleanname.tfm" ;
1219        print "$command\n" if $trace ;
1220        my $font = `$command` }
1221    else
1222      { report "use supplied tfm : $cleanname" }
1223    # report results
1224    if (!$lcdf)
1225    { ($rawfont,$cleanfont,$restfont) = split(/\s/,$font) }
1226    $cleanfont =~ s/\_/\-/goi ;
1227    $cleanfont =~ s/\-+$//goi ;
1228    # copy files
1229    my $usename = "$use$cleanname$fontsuffix" ;
1230    my $rawname = "$raw$cleanname$fontsuffix" ;
1231
1232    if ($lcdf eq "")
1233    { if ($strange ne "")
1234        { UnLink ("$vfpath/$cleanname.vf", "$tfmpath/$cleanname.tfm") ;
1235          copy ("$cleanname.tfm","$tfmpath/$cleanname.tfm") ;
1236          copy ("$usename.tfm","$tfmpath/$usename.tfm") ;
1237          # or when available, use vendor one :
1238          copy ("$sourcepath/$cleanname.tfm","$tfmpath/$cleanname.tfm") }
1239      elsif ($virtual)
1240        { UnLink ("$vfpath/$rawname.vf", "$vfpath/$usename.vf") ;
1241          UnLink ("$tfmpath/$rawname.tfm", "$tfmpath/$usename.tfm") ;
1242          copy ("$usename.vf" ,"$vfpath/$usename.vf") ;
1243          copy ("$rawname.tfm","$tfmpath/$rawname.tfm") ;
1244          copy ("$usename.tfm","$tfmpath/$usename.tfm") }
1245      elsif ($afmpl)
1246        { UnLink ("$vfpath/$rawname.vf", "$vfpath/$usename.vf", "$vfpath/$cleanname.vf") ;
1247          UnLink ("$tfmpath/$rawname.tfm", "$tfmpath/$usename.tfm", "$tfmpath/$cleanname.tfm") ;
1248          copy ("$usename.tfm","$tfmpath/$usename.tfm") }
1249      else
1250        { UnLink ("$vfpath/$usename.vf", "$tfmpath/$usename.tfm") ;
1251          # slow but prevents conflicting vf's
1252          my $rubish = `kpsewhich $usename.vf` ; chomp $rubish ;
1253          if ($rubish ne "") { UnLink $rubish }
1254          #
1255          copy ("$usename.tfm","$tfmpath/$usename.tfm") } }
1256    # cleanup
1257    foreach my $suf ("tfm", "vf", "vpl")
1258      { UnLink ("$rawname.$suf", "$usename.$suf") ;
1259        UnLink ("$cleanname.$suf", "$fontname.$suf") ;
1260        UnLink ("$cleanname$fontsuffix.$suf", "$fontname$fontsuffix.$suf") }
1261    # add line to map files
1262	my $str = my $thename = "";
1263    ($str, $thename) = build_pdftex_mapline($option, $usename, $fontname, $rawname, $cleanfont, $encoding, $varlabel, $strange);
1264	# check for redundant entries
1265    if (defined $PDFTEXMAP) {
1266	  $pdftexmapdata =~ s/^$thename\s.*?$//gmis ;
1267	  if ($afmpl) {
1268		if ($pdftexmapdata =~ s/^$rawname\s.*?$//gmis) {
1269		  report ("removing raw file : $rawname") ;
1270		}
1271	  }
1272	  $maplist .= $str ;
1273	  $pdftexmapdata .= $str ;
1274    }
1275    ($str, $thename) = build_dvips_mapline($option, $usename, $fontname, $rawname, $cleanfont, $encoding, $varlabel, $strange);
1276	# check for redundant entries
1277    if (defined $DVIPSMAP) {
1278	  $dvipsmapdata =~ s/^$thename\s.*?$//gmis ;
1279	  if ($afmpl) {
1280		if ($dvipsmapdata =~ s/^$rawname\s.*?$//gmis) {
1281		  report ("removing raw file : $rawname") ;
1282		}
1283	  }
1284	  $dvipsmapdata .= $str ;
1285    }
1286    ($str, $thename) = build_dvipdfm_mapline($option, $usename, $fontname, $rawname, $cleanfont, $encoding, $varlabel, $strange);
1287	# check for redundant entries
1288    if (defined $DVIPDFMMAP) {
1289	  $dvipdfmmapdata =~ s/^$thename\s.*?$//gmis ;
1290	  if ($afmpl) {
1291		if ($dvipdfmmapdata =~ s/^$rawname\s.*?$//gmis) {
1292		  report ("removing raw file : $rawname") ;
1293		}
1294	  }
1295	  $dvipdfmmapdata .= $str ;
1296    }
1297
1298    # write lines to tex file
1299    if (($strange eq "expert")&&($expert)) {
1300        $fntlist .= "\\definefontsynonym[$cleanfont$namesuffix][$cleanname] \% expert\n" ;
1301    } elsif ($strange ne "") {
1302        $fntlist .= "\%definefontsynonym[$cleanfont$namesuffix][$cleanname]\n" ;
1303    } else {
1304        $fntlist .= "\\definefontsynonym[$cleanfont$namesuffix][$usename][encoding=$encoding]\n" ;
1305    }
1306    next unless $tex ;
1307    if (($strange eq "expert")&&($expert)) {
1308        $texlist .= "\\ShowFont[$cleanfont$namesuffix][$cleanname]\n" ;
1309    } elsif ($strange ne "") {
1310        $texlist .= "\%ShowFont[$cleanfont$namesuffix][$cleanname]\n" ;
1311    } else {
1312        $texlist .= "\\ShowFont[$cleanfont$namesuffix][$usename][$encoding]\n"
1313    }
1314}
1315
1316finish_mapfile("pdftex",  $PDFTEXMAP,  $pdftexmapdata);
1317finish_mapfile("dvipdfm", $DVIPDFMMAP, $dvipdfmmapdata);
1318finish_mapfile("dvips",   $DVIPSMAP,   $dvipsmapdata);
1319
1320if ($tex)
1321  { my $mappath = mappath("pdftex");
1322    $mappath =~ s/\\/\//go ;
1323    $savedoptions =~ s/^\s+//gmois ; $savedoptions =~ s/\s+$//gmois ;
1324    $fntlist      =~ s/^\s+//gmois ; $fntlist      =~ s/\s+$//gmois ;
1325    $maplist      =~ s/^\s+//gmois ; $maplist      =~ s/\s+$//gmois ;
1326    print TEX "$texlist" ;
1327    print TEX "\n" ;
1328    print TEX "\\setupheadertexts[\\tttf example definitions]\n" ;
1329    print TEX "\n" ;
1330    print TEX "\\starttyping\n" ;
1331    print TEX "texfont $savedoptions\n" ;
1332    print TEX "\\stoptyping\n" ;
1333    print TEX "\n" ;
1334    print TEX "\\starttyping\n" ;
1335    print TEX "$mappath/$mapfile\n" ;
1336    print TEX "\\stoptyping\n" ;
1337    print TEX "\n" ;
1338    print TEX "\\starttyping\n" ;
1339    print TEX "$fntlist\n" ;
1340    print TEX "\\stoptyping\n" ;
1341    print TEX "\n" ;
1342    print TEX "\\page\n" ;
1343    print TEX "\n" ;
1344    print TEX "\\setupheadertexts[\\tttf $mapfile]\n" ;
1345    print TEX "\n" ;
1346    print TEX "\\starttyping\n" ;
1347    print TEX "$maplist\n" ;
1348    print TEX "\\stoptyping\n" ;
1349    print TEX "\n" ;
1350    print TEX "\\stoptext\n" }
1351
1352if ($tex) { close (TEX) }
1353
1354# atl: global cleanup with generated files (afm & ttf don't mix)
1355
1356UnLink(@cleanup) ;
1357
1358print "\n" ; report ("generating : ls-r databases") ;
1359
1360# Refresh database.
1361
1362print "\n" ; system ("mktexlsr $fontroot") ; print "\n" ;
1363
1364# Process the test file.
1365
1366if ($show) { system ("texexec --once --silent $texfile") }
1367
1368@files = validglob("$identifier.* *-$identifier.map") ;
1369
1370foreach my $file (@files)
1371  { unless ($file =~ /(tex|pdf|log|mp|tmp)$/io) { UnLink ($file) } }
1372
1373exit ;
1374