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