From 2f4fdf541dc04813bd2c8e2f3fad9a2ae66b71a3 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Wed, 11 Jan 2006 23:49:47 +0000 Subject: trunk/Master/texmf-dist/source/latex/CJK git-svn-id: svn://tug.org/texlive/trunk@118 c570f23f-e606-0410-a88d-b1316a301751 --- .../source/latex/CJK/utils/subfonts/clonevf.pl | 105 +++++++++++++++++++++ 1 file changed, 105 insertions(+) create mode 100644 Master/texmf-dist/source/latex/CJK/utils/subfonts/clonevf.pl (limited to 'Master/texmf-dist/source/latex/CJK/utils/subfonts/clonevf.pl') diff --git a/Master/texmf-dist/source/latex/CJK/utils/subfonts/clonevf.pl b/Master/texmf-dist/source/latex/CJK/utils/subfonts/clonevf.pl new file mode 100644 index 00000000000..f6b35b207a5 --- /dev/null +++ b/Master/texmf-dist/source/latex/CJK/utils/subfonts/clonevf.pl @@ -0,0 +1,105 @@ +#! /usr/bin/perl -w +# +# This script clones a virtual font from a TFM file. +# +# As prerequisites, it needs the programs `tftopl' and `vptovf', which must +# be in the path. +# +# Call the script as +# +# perl clonevf.pl tfm_name vf_name +# +# Example: +# +# perl clonevf.pl bsmiuv bsmilp + +use strict; + +my $prog = $0; +$prog =~ s@.*/@@; + +if ($#ARGV != 1) { + die("usage: $prog tfm_name vf_name\n"); +} + +my $tfmname = $ARGV[0]; +my $vfname = $ARGV[1]; + + +# Create PL file. + +print("Processing metrics file \`$tfmname.tfm'...\n"); + +my $arg = "tftopl $tfmname.tfm > $tfmname.pl"; +system($arg) == 0 +|| die("$prog: calling \`$arg' failed: $?\n"); + + +# Create VPL file. + +print("Writing virtual property list file \`$vfname.vpl'...\n"); + +open(PL, "$tfmname.pl") +|| die("$prog: can't open \`$tfmname.pl': $!\n"); + +open(VPL, ">", "$vfname.vpl") +|| die("$prog: can't open \`$vfname.vpl': $!\n"); + +print(VPL "(VTITLE Created by \`$prog " . join(" ", @ARGV) . "')\n"); +print(VPL "(FAMILY TEX-\U$vfname\E)\n"); + +my $have_mapfont = 0; +while () { + next if /^\(FAMILY/; + next if /^\(CHECKSUM/; + + if (/^\(CHARACTER (.*)/) { + if (!$have_mapfont) { + print(VPL "(MAPFONT D 0\n"); + print(VPL " (FONTNAME $tfmname)\n"); + print(VPL " )\n"); + $have_mapfont = 1; + } + + my $char = $1; + + print(VPL $_); + + $_ = ; + if (/CHARWD/) { + print(VPL $_); + $_ = ; + } + if (/CHARHT/) { + print(VPL $_); + $_ = ; + } + if (/CHARDP/) { + print(VPL $_); + $_ = ; + } + + print(VPL " (MAP\n"); + print(VPL " (SELECTFONT D 0)\n"); + print(VPL " (SETCHAR $char)\n"); + print(VPL " )\n"); + } + + print(VPL $_); +} + +close(PL); +close(VPL); + +print("Processing \`$vfname.vpl'\n"); +$arg = "vptovf $vfname.vpl"; +system($arg) == 0 +|| die("$prog: calling \`$arg' failed: $?\n"); + +print("Removing \`$tfmname.pl'...\n"); +unlink("$tfmname.pl"); +print("Removing \`$vfname.vpl'...\n"); +unlink("$vfname.vpl"); + + +# eof -- cgit v1.2.3