#!/usr/bin/env perl
-
+use 5.010;
use strict;
use warnings;
use utf8;
use open OUT => ':utf8', ':std';
-
-our $VERSION = '1.00';
+use charnames ':full';
+use Data::Dump 'pp';
+
+our $VERSION = '1.01';
+
+# translation table for deprecated code points
+my %replace = (
+ (map {$_ => 0} 0xE000 .. 0xE03F), # omit by default if unspecified
+ 0xE001 => 0, # /c join lines: not accepted
+ 0xE002 => "\N{EM QUAD}", # UA unit space A
+ #> ISO-IR 008-1: unit spaces A in position 4/0 and B in
+ #> position 6/0 are fixed length spaces whereby UA ≥ UB.
+ #> […] The lengths of UA and UB are determined by the user.
+ 0xE003 => "\N{EN QUAD}", # UB unit space B
+# 0xE004 => "\N{COMBINING DIAERESIS}", # "3 combining umlaut, unified with diaeresis
+# 0xE005 => "\N{COMBINING GREEK DIALYTIKA TONOS}", # "1 combining diaeresis+accent, unspecified
+ 0xE006 => "\N{COMBINING GRAVE ACCENT}", # "! combining grave
+ 0xE007 => "\N{COMBINING ACUTE ACCENT}", # "' combining acute
+ 0xE008 => "\N{COMBINING CIRCUMFLEX ACCENT}", # "> combining circumflex
+ 0xE009 => "\N{COMBINING TILDE}", # "? combining tilde
+ 0xE00A => "\N{COMBINING MACRON}", # "- combining macron
+ 0xE00B => "\N{COMBINING BREVE}", # "( combining breve
+ 0xE00C => "\N{COMBINING DOT ABOVE}", # ". combining dot above
+ 0xE00D => "\N{COMBINING DIAERESIS}", # ": combining diaeresis
+ 0xE00E => "\N{COMBINING RING ABOVE}", # "0 combining ring above
+ 0xE00F => "\N{COMBINING DOUBLE ACUTE ACCENT}", # "" combining double accute (sic)
+ 0xE010 => "\N{COMBINING CARON}", # "< combining caron
+ 0xE011 => "\N{COMBINING CEDILLA}", # ", combining cedilla
+ 0xE012 => "\N{COMBINING OGONEK}", # "; combining ogonek
+ 0xE013 => "\N{COMBINING LOW LINE}", # "_ combining low line
+ 0xE014 => "\N{COMBINING DOUBLE LOW LINE}", # "= combining double low line
+ 0xE015 => "\N{COMBINING LONG SOLIDUS OVERLAY}", # "/ combining long solidus
+ 0xE016 => "\N{COMBINING GREEK YPOGEGRAMMENI}", # "i combining greek iota below
+ 0xE017 => "\N{COMBINING REVERSED COMMA ABOVE}", # "d combining greek dasia pneumata
+ 0xE018 => "\N{COMBINING COMMA ABOVE}", # "p combining greek psili pneumata
+ 0xE019 => "\N{GREEK DASIA}", # ;; greek dasia pneumata
+ 0xE01A => "\N{GREEK PSILI}", # ,, greek psili pneumata
+ 0xE01B => "\N{GREEK BETA SYMBOL}", # b3 middle beta = curled beta?
+ 0xE01C => "\N{WHITE CIRCLE}", # Ci circle
+ 0xE01D => "\N{LATIN SMALL LETTER F WITH HOOK}", # f( function sign
+ 0xE01E => "\N{LATIN SMALL LETTER EZH}", # ed ezh
+ 0xE01F => "\N{SQUARE AM}", # am, compatibility char
+ 0xE020 => "\N{SQUARE PM}", # pm, compatibility char
+ 0xE021 => "\N{TELEPHONE SIGN}", # Tel, compatibility char
+ 0xE022 => "\N{ARABIC LETTER ALEF FINAL FORM}", # a+: final alef compatibility
+# 0xE023 => "\N{LATIN SMALL LETTER F WITH HOOK}", # Fl dutch guilder, unified with function sign, obsolete
+# 0xE024 => "\N{GREEK CAPITAL LETTER GAMMA}", # GF gamma function sign, unified with letter
+ 0xE025 => "\N{COMBINING RIGHT ARROW ABOVE}", # >V combining(?) rightwards vector above; also U+20D1
+ 0xE026 => "\N{GREEK VARIA}", # !* greek varia
+ 0xE027 => "\N{GREEK PERISPOMENI}", # ?* greek perispomeni
+ 0xE028 => "J\N{COMBINING CARON}", # J< J-caron = uppercase U+01F0, no single character
+);
# expect input data source at command line
@ARGV or die "Specify input source file or - for STDIN\n";
do {
$_ = readline;
defined or die "Premature input end";
-} until /^\s\S/;
+} until s/^\s(?=\S)//;
-my @t = $_; # add first line (already read, assume it's ok)
+chomp;
+my @line = $_; # add first line (already read, assume it's ok)
# read the rest of the character table
while ($_ = readline) {
next unless s/^ //;
chomp;
- # add the line to @t
+ # append line contents
if (s/^ {15}/ /) {
# continuation line (add to last entry)
- $t[-1] .= $_;
+ $line[-1] .= $_;
}
else {
# add a new entry
- push @t, $_;
+ push @line, $_;
}
}
-# create a hash of desired input
-my %di;
-for (@t) {
- my ($mnem, $char, $name) = split / +/, $_, 3;
- next if length $mnem != 2;
- $di{$mnem} = hex $char;
-}
-
-# XXX
-my %trans = (
- 0xE001 => 0, # join lines: not accepted
- 0xE004 => 0, # umlaut is no different from diaeresis 0x0308
- 0xE005 => 0x0344, # discouraged
- 0xE006 => 0x0300,
- 0xE007 => 0x0301,
- 0xE008 => 0x0302,
- 0xE009 => 0x0303,
- 0xE00A => 0x0304,
- 0xE00B => 0x0306,
- 0xE00C => 0x0307,
- 0xE00D => 0x0308,
- 0xE00E => 0x030A,
- 0xE00F => 0x030B,
- 0xE010 => 0x030C,
- 0xE011 => 0x0327,
- 0xE012 => 0x0328,
- 0xE013 => 0x0332,
- 0xE014 => 0x0333,
- 0xE015 => 0x0338,
- 0xE016 => 0x0345,
- 0xE017 => 0x0314,
- 0xE018 => 0x0313,
- 0xE019 => 0x1FFE,
- 0xE01A => 0x1FBF,
- 0xE01B => 0x03D0, # middle beta = curled beta?
- 0xE01C => 0x25CB,
- 0xE01D => 0x0192,
- 0xE01E => 0x0292,
- 0xE01F => 0x33C2, # am, compatibility char
- 0xE020 => 0x33D8, # pm, compatibility char
- 0xE021 => 0x2121,
- 0xE022 => 0xFE8E,
- 0xE023 => 0, # dutch guilder 0192 is already encoded, and not very useful anyway
- 0xE024 => 0x0393,
- 0xE025 => 0x20D7, # also 20D1; non-spacing
- 0xE026 => 0x1FEF,
- 0xE027 => 0x1FC0,
- 0xE028 => 0x01F0, #but uppercase
-);
-for (values %di) {
- $_ >= 0xE000 or next;
- $_ = $trans{$_} if defined $trans{$_};
-}
-
# output perl code of hash
# (assume no backslashes or curlies, so we can just q{} w/o escaping)
-print "# automatically generated by $0\n";
-print "use utf8;\n";
-print "+{\n";
-printf "q{%s}=>%s,\n", $_, $di{$_} for sort keys %di;
-print "}\n";
+say "# automatically generated by $0";
+say 'use utf8;';
+say '+{';
+for (@line) {
+ my ($mnem, $chrhex, $name) = split / +/, $_, 3;
+ next if length $mnem != 2;
+ my $chrnum = hex $chrhex;
+ my $chr = $replace{$chrnum} // chr $chrnum or next;
+ my $chrstr = pp $chr;
+ say "q{$mnem} => $chrstr, # $name";
+}
+say '}';
__END__