summaryrefslogtreecommitdiff
path: root/Build
diff options
context:
space:
mode:
Diffstat (limited to 'Build')
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/jfmutil/jfmutil.pl168
1 files changed, 163 insertions, 5 deletions
diff --git a/Build/source/texk/texlive/linked_scripts/jfmutil/jfmutil.pl b/Build/source/texk/texlive/linked_scripts/jfmutil/jfmutil.pl
index 7699dbcf120..5243ba75da1 100755
--- a/Build/source/texk/texlive/linked_scripts/jfmutil/jfmutil.pl
+++ b/Build/source/texk/texlive/linked_scripts/jfmutil/jfmutil.pl
@@ -2770,8 +2770,8 @@ package main;
#================================================= BEGIN
use Encode qw(encode decode);
my $prog_name = 'jfmutil';
-my $version = '1.0.1';
-my $mod_date = '2017/07/21';
+my $version = '1.1.0';
+my $mod_date = '2017/09/16';
#use Data::Dump 'dump';
#
my ($sw_hex, $sw_uptool, $sw_noencout, $inenc, $exenc);
@@ -2860,9 +2860,13 @@ sub main_zpl2tfm {
}
sub show_usage {
- my ($v, $m) = @_;
+ print(usage_message());
+ exit;
+}
+sub usage_message {
+ my ($v, $m);
($v, $m) = textool_version() or error();
- print <<"END"; exit;
+ return <<"END";
This is $prog_name v$version <$mod_date> by 'ZR'.
[ZRTeXtor library v$v <$m> by 'ZR']
Usage: $prog_name vf2zvp0 [<options>] <in.vf> [<out.zvp0>]
@@ -2871,7 +2875,11 @@ Usage: $prog_name vf2zvp0 [<options>] <in.vf> [<out.zvp0>]
$prog_name zvp2vf [<options>] <in.zvp> [<out.vf> <out.tfm>]
$prog_name zpl2tfm [<options>] <in.zvp0> [<out.vf>]
$prog_name tfm2zpl [<options>] <in.zvp0> [<out.vf>]
- VF and TFM files are searched by kpsewhich.
+Arguments:
+ <in.xxx> input files
+ N.B. Input TFM/VF files are searched by Kpathsea. (ZVP/ZVP9 are not.)
+ <out.xxx> output files
+Options:
--hex output charcode in 'H' form [default]
-o / --octal output charcode in 'O' form
--uptool use upTeX tools (uppltotf etc.)
@@ -2981,6 +2989,156 @@ sub error {
#================================================= END
+#------------------------------------------------- pxcopyfont interfaces
+
+*usage_message_org = \&usage_message;
+
+*usage_message = sub {
+ local $_ = usage_message_org();
+ my ($part1, $part2) = (<<"EOT1", <<"EOT2");
+
+* ZVP Conversion
+EOT1
+
+* VF Replication
+Usage: $prog_name vfcopy [<options>] <in.vf> <out.zvf> <out_base.tfm>...
+ $prog_name vfinfo [<options>] <in.vf>
+Arguments:
+ <in.vf> input virtual font name
+ N.B. Input TFM/VF files are searched by Kpathsea.
+ <out.vf> output virtual font name
+ <out_base.tfm> names of raw TFMs referred by the output virtual font;
+ each entry replaces a font mapping in the input font in
+ the given order, so the exactly same number of entries
+ must be given as font mappings
+Options:
+ -z / --zero change first fontmap id in vf to zero
+EOT2
+ s/(Usage:)/$part1$1/; s/$/$part2/;
+ return $_;
+};
+
+%procs = (%procs,
+ vfinfo => \&main_vfinfo,
+ vfcopy => \&main_vfcopy,
+);
+
+sub main_vfinfo {
+ PXCopyFont::read_option(1);
+ PXCopyFont::info_vf();
+}
+
+sub main_vfcopy {
+ PXCopyFont::read_option(0);
+ PXCopyFont::copy_vf();
+}
+
+#------------------------------------------------- pxcopyfont stuffs
+package PXCopyFont;
+
+*info = *main::show_info;
+*error = *main::error;
+
+our ($src_main, $dst_main, @dst_base, $op_zero);
+
+sub copy_vf {
+ local $_ = main::read_whole_file(main::kpse("$src_main.vf"), 1) or error();
+ my $vfc = parse_vf($_);
+ my ($nb, $nb1) = (scalar(@{$vfc->[0]}), scalar(@dst_base));
+ info("number of base TFMs in '$src_main'", $nb);
+ if ($dst_base[-1] eq '...' && $nb1 <= $nb) {
+ foreach ($nb1-1 .. $nb-1) { $dst_base[$_] = $vfc->[0][$_][1]; }
+ } elsif ($nb != $nb1) {
+ error("wrong number of base TFMs given", $nb1);
+ }
+ main::write_whole_file("$dst_main.vf", form_vf($vfc), 1) or error();
+ main::write_whole_file("$dst_main.tfm",
+ main::read_whole_file(main::kpse("$src_main.tfm"), 1), 1) or error();
+ foreach my $k (0 .. $#dst_base) {
+ my $sfn = $vfc->[0][$k][1]; my $dfn = $dst_base[$k];
+ ($sfn ne $dfn) or next;
+ main::write_whole_file("$dfn.tfm",
+ main::read_whole_file(main::kpse("$sfn.tfm"), 1), 1) or error();
+ }
+}
+
+sub parse_vf {
+ my ($vf) = @_; my (@fs, @lst, $pos);
+ @fs = unpack("CCC", $vf);
+ ($fs[0] == 0xf7 && $fs[1] == 0xca) or return;
+ $pos = $fs[2] + 11; my $hd = substr($vf, 0, $pos);
+ while (1) {
+ @fs = unpack("CC", substr($vf, $pos, 2));
+ (243 <= $fs[0] && $fs[0] <= 246) or last;
+ my $fid = ($fs[0] == 243) ? $fs[1] : 999;
+ my $t = $fs[0] - 242 + 13;
+ @fs = unpack("a${t}CC", substr($vf, $pos, 260));
+ my $l = $fs[1] + $fs[2]; my $n = substr($vf, $pos + $t + 2, $l);
+ $pos += $t + 2 + $l; push(@lst, [ $fs[0], $n, $fid ]);
+ if ($n !~ m/^[\x21-\x7e]+$/) {
+ $n =~ s/([^\x21-\x5b\x5d-\x7e])/sprintf("\\x%02x", ord($1))/g;
+ error("bad tfm name recorded in VF", $n);
+ }
+ }
+ my $ft = substr($vf, $pos); $ft =~ s/\xf8+\z//g;
+ return [ \@lst, $hd, $ft ];
+}
+
+sub info_vf {
+ local $_ = main::read_whole_file(main::kpse("$src_main.vf"), 1) or error();
+ my $vfc = parse_vf($_);
+ foreach (@{$vfc->[0]}) {
+ printf("%d=%s\n", $_->[2], $_->[1]);
+ }
+}
+
+sub form_vf {
+ my ($vfc) = @_; my (@lst);
+ if ($op_zero) {{
+ my $t = $vfc->[0][0] or last;
+ ($t->[2] == 0) and last; # already zero
+ info("change first fontmap id to zero (from " . $t->[2] . ")");
+ substr($t->[0], 1, 1) = "\0"; $t->[2] = 0;
+ }}
+ foreach my $k (0 .. $#{$vfc->[0]}) {
+ my $t = $vfc->[0][$k]; my $sfn = $t->[1];
+ my $dfn = $dst_base[$k];
+ (length($dfn) < 256) or error("TFM name too long", $dfn);
+ info("id=".$t->[2], $sfn, $dfn);
+ push(@lst, $t->[0], "\0" . chr(length($dfn)), $dfn);
+ }
+ my $tfm = join('', $vfc->[1], @lst, $vfc->[2]);
+ return $tfm . ("\xf8" x (4 - length($tfm) % 4));
+}
+
+sub read_option {
+ my ($op_info) = @_;
+ $op_zero = 0;
+ while ($ARGV[0] =~ m/^-/) {
+ my $opt = shift(@ARGV);
+ if ($opt =~ m/--?h(elp)?/) {
+ show_usage();
+ } elsif ($opt eq '-z' || $opt eq '--zero') {
+ $op_zero = 1;
+ } else {
+ error("invalid option", $opt);
+ }
+ }
+ ($src_main, $dst_main, @dst_base) = @ARGV;
+ $src_main =~ s/\.vf$//;
+ (defined $src_main) or error("no argument given");
+ (!!$op_info == (!defined $dst_main))
+ or error("wrong number of arguments");
+ if (defined $dst_main) {
+ $dst_main =~ s/\.vf$//;
+ foreach (@dst_base) { s/\.tfm$//; }
+ ($src_main ne $dst_main)
+ or error("output vf name is same as input");
+ (@dst_base) or error("no base tfm name given");
+ }
+}
+
#------------------------------------------------- go to main
+package main;
main();
## EOF