summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/scripts/jfmutil
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2019-02-09 22:18:30 +0000
committerKarl Berry <karl@freefriends.org>2019-02-09 22:18:30 +0000
commit4f8cc28897359bc2d56445dd0736754f8853edae (patch)
tree5df2c2107a793ea8fdd0c4f55a087bbaa9eef1a7 /Master/texmf-dist/scripts/jfmutil
parent5f8e85de17142975cc044824ffe885c7aa953c3a (diff)
jfmutil (9feb19)
git-svn-id: svn://tug.org/texlive/trunk@49986 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/scripts/jfmutil')
-rwxr-xr-xMaster/texmf-dist/scripts/jfmutil/jfmutil.pl281
1 files changed, 240 insertions, 41 deletions
diff --git a/Master/texmf-dist/scripts/jfmutil/jfmutil.pl b/Master/texmf-dist/scripts/jfmutil/jfmutil.pl
index 63835b85b69..3b4b5b76bc0 100755
--- a/Master/texmf-dist/scripts/jfmutil/jfmutil.pl
+++ b/Master/texmf-dist/scripts/jfmutil/jfmutil.pl
@@ -2,7 +2,7 @@
#
# This is file 'jfmutil.pl'.
#
-# Copyright (c) 2018 Takayuki YATO (aka. "ZR")
+# Copyright (c) 2019 Takayuki YATO (aka. "ZR")
# GitHub: https://github.com/zr-tex8r
# Twitter: @zr_tex8r
#
@@ -12,8 +12,8 @@ use strict;
#------------------------------------------------- ZRTeXtor module
package ZRTeXtor;
-our $VERSION = 1.004_01;
-our $mod_date = "2018/01/20";
+our $VERSION = 1.005_00;
+our $mod_date = "2018/01/21";
use Encode qw(encode decode);
# Here follows excerpt from ZRTeXtor.pm
@@ -2139,8 +2139,6 @@ sub vf_assign_type
$_, $sty, $stype->{$_}));
$stype->{$_} = $sty;
} elsif ($ty != 0) { # set type >0
- ($_ <= 0xFFFF) or return error(
- sprintf("code value out of range: char %04X", $_));
(defined $type->{$_}) or return error(
sprintf("type assignment (%s) to char out of codespace:" .
"char %04X",
@@ -2501,7 +2499,10 @@ sub jfm_form_postprocess
($fs[0] == 9 || $fs[0] == 11)) or return;
$pct = $fs[3] * 4 + 28; $lct = $fs[1] * 4;
$ct = substr($jfm, $pct, $lct); @fs = unpack('n*', $ct);
- for ($k = 2; $k <= $#fs; $k += 2) { $fs[$k] = $map->{$fs[$k]}; }
+ for ($k = 2; $k <= $#fs; $k += 2) {
+ my $cc = $map->{$fs[$k]};
+ $fs[$k] = ($cc & 0xFFFF); $fs[$k+1] |= ($cc >> 16 << 8);
+ }
$ct = pack('n*', @fs);
return substr($jfm, 0, $pct) . $ct . substr($jfm, $pct + $lct);
}
@@ -2517,7 +2518,8 @@ sub jfm_parse_preprocess
$pct = $fs[3] * 4 + 28; $lct = $fs[1] * 4;
$ct = substr($jfm, $pct, $lct); @fs = unpack('n*', $ct);
for ($jc = 0x2121, $k = 2; $k <= $#fs; $k += 2) {
- $map{$jc} = $fs[$k]; $fs[$k] = $jc;
+ $map{$jc} = ($fs[$k] | $fs[$k+1] >> 8 << 16);
+ $fs[$k] = $jc; $fs[$k+1] &= 0xFF;
$jc = jfm_nextcode($jc) or return;
}
$ct = pack('n*', @fs);
@@ -2758,23 +2760,23 @@ package main;
pl_parse pl_form pl_prefer_hex
jcode_set
kpse
- vf_parse vf_form vf_parse_ex vf_form_ex
+ vf_parse vf_form vf_parse_ex vf_form_ex vf_strict
jfm_use_uptex_tool jfm_parse jfm_form
)) {
*{$_} = *{"ZRTeXtor::".$_};
}
}
-#------------------------------------------------- jfmutil stuffs
-# Here follows excerpt from jfmutil.pl
+#------------------------------------------------- pxutil stuffs
+# Here follows excerpt from pxutil.pl
#================================================= BEGIN
use Encode qw(encode decode);
my $prog_name = 'jfmutil';
-my $version = '1.1.0';
-my $mod_date = '2017/09/16';
+my $version = '1.2.1';
+my $mod_date = '2019/02/08';
#use Data::Dump 'dump';
#
-my ($sw_hex, $sw_uptool, $sw_noencout, $inenc, $exenc);
+my ($sw_hex, $sw_uptool, $sw_noencout, $inenc, $exenc, $sw_lenient);
my ($proc_name, $infile, $in2file ,$outfile, $out2file);
#### main procedure
@@ -2789,14 +2791,21 @@ my %procs = (
);
sub main {
- my ($proc);
if (defined textool_error()) { error(); }
- if ((($proc_name) = $ARGV[0] =~ m/^:?(\w+)$/)
- && defined($proc = $procs{$proc_name})) {
- shift(@ARGV); $proc->();
- } else {
+ local $_ = shift(@ARGV);
+ if (!defined $_) {
show_usage();
- }
+ } elsif (($proc_name) = m/^:?(\w+)$/) {
+ my $proc = $procs{$proc_name};
+ (defined $proc) or error("unknown subcommand name", $proc_name);
+ $proc->();
+ } elsif (m/^-/) {
+ if (m/^--?h(?:elp)?$/) {
+ show_usage();
+ } elsif (m/^-(?:V|-version)$/) {
+ show_version();
+ } else { error("unknown (or invalid usage of) option", $_); }
+ } else { error("invalid argument", $_); }
}
sub main_vf2zvp0 {
@@ -2863,10 +2872,14 @@ sub show_usage {
print(usage_message());
exit;
}
+sub show_version {
+ print("$prog_name version $version\n");
+ exit;
+}
sub usage_message {
my ($v, $m);
($v, $m) = textool_version() or error();
- return <<"END";
+ return <<"EOT1", <<"EOT2";
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>]
@@ -2883,13 +2896,17 @@ Options:
--hex output charcode in 'H' form [default]
-o / --octal output charcode in 'O' form
--uptool use upTeX tools (uppltotf etc.)
+ --lenient ignore non-fatal error on VFs
The following options affect interpretation of 'K' form.
--kanji=ENC set source encoding: ENC=jis/sjis/euc/utf8/none
--kanji-internal=ENC set internal encoding: ENC=jis/unicode/none
-j / --jis == --kanji=jis --kanji-internal=jis
-u / --unicode == --kanji=utf8 --kanji-internal=unicode
-E / --no-encoding == --kanji=none --kanji-internal=none
-END
+EOT1
+ -h / --help show this help message and exit
+ -V / --version show version
+EOT2
}
#### command-line options
@@ -2901,12 +2918,16 @@ sub read_option {
$opt = shift(@ARGV);
if ($opt =~ m/--?h(elp)?/) {
show_usage();
+ } elsif ($opt =~ m/-(?:V|-version)?/) {
+ show_version();
} elsif ($opt eq '--hex') {
$sw_hex = 1;
} elsif ($opt eq '--octal' || $opt eq '-o') {
$sw_hex = 0;
} elsif ($opt eq '--uptool') {
$sw_uptool = 1;
+ } elsif ($opt eq '--lenient') {
+ $sw_lenient = 1;
} elsif ($opt eq '--no-encoding' || $opt eq '-E') {
($exenc, $inenc) = ('none', 'none');
} elsif ($opt eq '--jis' || $opt eq '-j') {
@@ -2927,6 +2948,7 @@ sub read_option {
or error("unknown internal kanji code: $inenc");
#if ($inenc eq 'unicode') { $sw_uptool = 1; }
if ($sw_hex) { pl_prefer_hex(1); }
+ if ($sw_lenient) { vf_strict(0); }
(0 <= $#ARGV && $#ARGV <= 1)
or error("wrong number of arguments");
if ($proc_name eq 'vf2zvp0') {
@@ -2994,15 +3016,16 @@ sub error {
*usage_message_org = \&usage_message;
*usage_message = sub {
- local $_ = usage_message_org();
+ 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>...
+Usage: $prog_name vfcopy [<options>] <in.vf> <out.vf> <out_base.tfm>...
$prog_name vfinfo [<options>] <in.vf>
+ $prog_name jodel [<options>] <in.vf> <prefix>
Arguments:
<in.vf> input virtual font name
N.B. Input TFM/VF files are searched by Kpathsea.
@@ -3011,38 +3034,58 @@ Arguments:
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
+ <prefix> prefix of output font names (only for jodel)
Options:
- -z / --zero change first fontmap id in vf to zero
+ -z / --zero change first fontmap id in vf to zero
+ --uptex assume input font to be for upTeX (only for jodel)
+ --unicode generate VF for 'direct-unicode' mode imposed by pxufont
+ package; this option is supported only for upTeX fonts and
+ thus implies '--uptex' (only for jodel)
+
+* Common Options
+ -h / --help show this help message and exit
+ -V / --version show version
EOT2
- s/(Usage:)/$part1$1/; s/$/$part2/;
+ s/(Usage:)/$part1$1/; s/\z/$part2/;
return $_;
};
%procs = (%procs,
vfinfo => \&main_vfinfo,
vfcopy => \&main_vfcopy,
+ jodel => \&main_jodel,
);
sub main_vfinfo {
- PXCopyFont::read_option(1);
+ PXCopyFont::read_option('vfinfo');
PXCopyFont::info_vf();
}
sub main_vfcopy {
- PXCopyFont::read_option(0);
+ PXCopyFont::read_option('vfcopy');
PXCopyFont::copy_vf();
}
+sub main_jodel {
+ PXCopyFont::read_option('jodel');
+ PXCopyFont::jodel();
+}
+
#------------------------------------------------- pxcopyfont stuffs
package PXCopyFont;
-*info = *main::show_info;
*error = *main::error;
+*read_whole_file = *main::read_whole_file;
+*write_whole_file = *main::write_whole_file;
-our ($src_main, $dst_main, @dst_base, $op_zero);
+our ($src_main, $dst_main, @dst_base, $op_zero, $op_uptex, $op_quiet);
+
+sub info {
+ ($op_quiet) or main::show_info(@_);
+}
sub copy_vf {
- local $_ = main::read_whole_file(main::kpse("$src_main.vf"), 1) or error();
+ local $_ = 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);
@@ -3051,14 +3094,14 @@ sub copy_vf {
} 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();
+ write_whole_file("$dst_main.vf", form_vf($vfc), 1) or error();
+ write_whole_file("$dst_main.tfm",
+ 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();
+ write_whole_file("$dfn.tfm",
+ read_whole_file(main::kpse("$sfn.tfm"), 1), 1) or error();
}
}
@@ -3085,7 +3128,7 @@ sub parse_vf {
}
sub info_vf {
- local $_ = main::read_whole_file(main::kpse("$src_main.vf"), 1) or error();
+ local $_ = read_whole_file(main::kpse("$src_main.vf"), 1) or error();
my $vfc = parse_vf($_);
foreach (@{$vfc->[0]}) {
printf("%d=%s\n", $_->[2], $_->[1]);
@@ -3112,14 +3155,22 @@ sub form_vf {
}
sub read_option {
- my ($op_info) = @_;
- $op_zero = 0;
+ my ($proc) = @_;
+ $op_zero = 0; $op_uptex = 0; $op_quiet = 0;
while ($ARGV[0] =~ m/^-/) {
my $opt = shift(@ARGV);
if ($opt =~ m/--?h(elp)?/) {
- show_usage();
+ main::show_usage();
+ } elsif ($opt =~ m/-(?:V|-version)?/) {
+ main::show_version();
} elsif ($opt eq '-z' || $opt eq '--zero') {
$op_zero = 1;
+ } elsif ($opt eq '--uptex') {
+ $op_uptex = 1;
+ } elsif ($opt eq '--unicode') {
+ $op_uptex = 2;
+ } elsif ($opt eq '--quiet') { # undocumented
+ $op_quiet = 2;
} else {
error("invalid option", $opt);
}
@@ -3127,15 +3178,163 @@ sub read_option {
($src_main, $dst_main, @dst_base) = @ARGV;
$src_main =~ s/\.vf$//;
(defined $src_main) or error("no argument given");
- (!!$op_info == (!defined $dst_main))
+ (($proc eq 'vfinfo') ? (!defined $dst_main) :
+ ($proc eq 'vfcopy') ? (defined $dst_main) :
+ ($proc eq 'jodel') ? (defined $dst_main && $#dst_base == -1) : 1)
or error("wrong number of arguments");
- if (defined $dst_main) {
+ if ($proc eq 'vfcopy') {
$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");
}
+ if ($proc eq 'jodel') {
+ (!$op_zero) or error("invalid in jodel command", "-z/--zero");
+ ($dst_main =~ m/^\w+$/)
+ or error("bad characters in prefix", $dst_main);
+ (length($dst_main) <= 100) or error("prefix too long", $dst_main);
+ } else {
+ (!$op_uptex) or error("invalid except in jodel command", "--uptex");
+ }
+}
+
+#------------------------------- jodel
+
+our %standard_vf = (
+ 'rml' => [1, 'hXXXN-h'],
+ 'rmlv' => [1, 'hXXXN-v'],
+ 'uprml-h' => [2, 'uphXXXN-h'],
+ 'uprml-hq' => [2, 'jodhXXX-hq'],
+ 'uprml-v' => [2, 'uphXXXN-v'],
+ 'gbm' => [1, 'hXXXN-h'],
+ 'gbmv' => [1, 'hXXXN-v'],
+ 'upgbm-h' => [2, 'uphXXXN-h'],
+ 'upgbm-hq' => [2, 'jodhXXX-hq'],
+ 'upgbm-v' => [2, 'uphXXXN-v'],
+);
+our @shape = (
+ 'minl', 'minr', 'minb', 'gothr', 'gothb', 'gotheb', 'mgothr'
+);
+
+our ($jengine, $jtate, @jvfname, %jvfidx, %jvfparsed);
+
+sub jodel {
+ jodel_analyze();
+ if ($op_uptex == 2) {
+ ($jengine == 2)
+ or error("direct-unicode mode is only supported for pure upTeX fonts");
+ foreach (values %standard_vf) {
+ ($_->[1] =~ m/^jod/) and $_->[1] =~ s/jod/zu-jod/;
+ }
+ }
+ foreach (@shape) {
+ jodel_generate($_, '');
+ jodel_generate($_, 'n');
+ }
+}
+
+sub jodel_vf_name {
+ my ($shp, $nn, $idx) = @_;
+ my $zu = ($op_uptex == 2) ? 'zu-' : '';
+ my $i = ($idx > 0) ? "$idx" : '';
+ my $up = (jodel_for_uptex()) ? 'up' : '';
+ my $hv = ($jtate) ? 'v' : 'h';
+ return "$zu$dst_main-$i-${up}nml$shp$nn-$hv";
+}
+sub jodel_tfm_name {
+ my ($shp, $nn, $nam) = @_;
+ $nam =~ s/XXX/\Q$shp\E/; $nam =~ s/N/\Q$nn\E/;
+ return $nam;
+}
+sub jodel_for_uptex {
+ return ($jengine == 2 || ($jengine == 3 && $op_uptex));
+}
+
+{
+ my (%jkpse);
+ sub jodel_kpse {
+ my ($in) = @_;
+ if (exists $jkpse{$in}) { return $jkpse{$in}; }
+ my $out = main::kpse($in); $jkpse{$in} = $out;
+ return $out;
+ }
+}
+
+sub jodel_clone {
+ my ($val) = @_;
+ if (ref($val) eq '') {
+ return $val;
+ } elsif (ref($val) eq 'ARRAY') {
+ return [ map { jodel_clone($_) } (@$val) ];
+ } else { error("OOPS", 98, ref($val)); }
+}
+
+sub jodel_analyze {
+ local ($_);
+ info("**** Analyze VF '$src_main'");
+ $_ = read_whole_file(jodel_kpse("$src_main.tfm"), 1) or error();
+ $jtate = (unpack('n', $_) == 9);
+ info("direction", ($jtate) ? 'tate' : 'yoko');
+ @jvfname = ($src_main); $jengine = 0;
+ info("base TFMs", "");
+ for (my $i = 0; $i <= $#jvfname; $i++) {
+ my $nvf = $jvfname[$i];
+ $_ = read_whole_file(jodel_kpse("$nvf.vf"), 1)
+ or error(($i > 0) ? ("non-standard raw TFM", $nvf) : ());
+ $_ = parse_vf($_) or error();
+ $jvfidx{$nvf} = $i; $jvfparsed{$nvf} = $_;
+ my @lst = map { $_->[1] } @{$_->[0]};
+ info(" $nvf -> @lst");
+ foreach (@lst) {
+ if (exists $standard_vf{$_}) {
+ $jengine |= $standard_vf{$_}[0];
+ next;
+ }
+ (exists $jvfidx{$_}) and next;
+ push(@jvfname, $_);
+ }
+ }
+ my $eng = (jodel_for_uptex()) ? 'upTeX' : 'pTeX';
+ ($jengine == 3) and $eng .= ' (mixed)';
+ info("engine", $eng);
+}
+
+sub jodel_generate {
+ my ($shp, $nn) = @_; local ($_);
+ my $dnvf0 = jodel_vf_name($shp, $nn, 0);
+ info("*** Generate VF '$dnvf0'");
+ foreach my $i (0 .. $#jvfname) {
+ my $snvf = $jvfname[$i];
+ my $dnvf = jodel_vf_name($shp, $nn, $i);
+ my $vfc = jodel_clone($jvfparsed{$snvf});
+ my (@slst, @dlst);
+ foreach my $e (@{$vfc->[0]}) {
+ my $sbas = $e->[1]; my $dbas;
+ if (exists $standard_vf{$sbas}) {
+ $dbas = jodel_tfm_name($shp, $nn, $standard_vf{$sbas}[1]);
+ } elsif (exists $jvfidx{$sbas}) {
+ $dbas = jodel_vf_name($shp, $nn, $jvfidx{$sbas});
+ } else { error("OOPS", 95, "$sbas"); }
+ push(@slst, $sbas); push(@dlst, $dbas);
+ $e->[1] = $dbas;
+ }
+ info("from", "$snvf -> @slst");
+ info(" to", "$dnvf -> @dlst");
+ write_whole_file("$dnvf.vf", jodel_form_vf($vfc), 1) or error();
+ write_whole_file("$dnvf.tfm",
+ read_whole_file(jodel_kpse("$snvf.tfm"), 1), 1) or error();
+ }
+}
+
+sub jodel_form_vf {
+ my ($vfc) = @_; my (@lst);
+ foreach my $k (0 .. $#{$vfc->[0]}) {
+ my $t = $vfc->[0][$k]; my $dfn = $t->[1];
+ 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));
}
#------------------------------------------------- go to main