summaryrefslogtreecommitdiff
path: root/language/japanese/japanese-otf/src/script/MakeSPList.pm
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2022-02-18 03:01:44 +0000
committerNorbert Preining <norbert@preining.info>2022-02-18 03:01:44 +0000
commit41041c6bdcedcc33698491c2caec4cd725a4fe97 (patch)
tree59aa0f9e0235ceee2474351b4b1a90a1eace6619 /language/japanese/japanese-otf/src/script/MakeSPList.pm
parentbd0e05b5b4dba5b38512acb2e7104f180fdb97e6 (diff)
CTAN sync 202202180301
Diffstat (limited to 'language/japanese/japanese-otf/src/script/MakeSPList.pm')
-rw-r--r--language/japanese/japanese-otf/src/script/MakeSPList.pm71
1 files changed, 71 insertions, 0 deletions
diff --git a/language/japanese/japanese-otf/src/script/MakeSPList.pm b/language/japanese/japanese-otf/src/script/MakeSPList.pm
new file mode 100644
index 0000000000..8dc9ce0e3a
--- /dev/null
+++ b/language/japanese/japanese-otf/src/script/MakeSPList.pm
@@ -0,0 +1,71 @@
+package MakeSPList;
+
+use strict;
+use Exporter;
+use File::Basename qw/dirname/;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(make_sp_char_list);
+
+=head1 NAME
+
+MakeSPList.pm
+
+=head1 NOTE
+
+This software is a part of otfbeta-uptex (a.k.a. japanese-otf-uptex).
+
+=cut
+
+our ($r_exist_head, $r_exist_char);
+
+my $num = '[12][0-9A-F]{4}';
+
+sub make_sp_char_list(@) {
+ my (@lang)=@_;
+ my (@exist_head_mul, %exist_char_mul)=();
+ my ($lang, $first_hex);
+
+ my $moduledir=dirname(__FILE__);
+
+ foreach $lang (@lang) {
+ open(LIST, "$moduledir/sp_list_$lang.txt") || die "$!";
+ my (@exist_head_each, %exist_char_each)=();
+ while (<LIST>) {
+ chomp;
+ s/\s+//g;
+ next if (/^[#%]/);
+ s/[#%].*$//;
+ s/,$//;
+ my @tmp;
+ foreach $_ (split ',', $_) {
+ if (/^($num)$/io) {
+ @tmp = (hex($1));
+ } elsif (/^($num)-($num)$/io) {
+ @tmp = (hex($1)..hex($2));
+ } else {
+ die "input [$_] is not expected\n";
+ }
+ foreach $_ (@tmp) {
+ my $HEX=sprintf("%X",$_);
+ $first_hex=int($_/0x1000);
+ $exist_head_each[$first_hex]++;
+ $exist_char_each{$HEX}=1;
+ if ($exist_char_mul{$HEX} eq '' && $exist_head_mul[$first_hex]!~/$lang/) {
+ $exist_head_mul[$first_hex].=$lang;
+ }
+ $exist_char_mul{$HEX}.=$lang;
+# warn "$HEX $first_hex ",sprintf("%X",$first_hex),"\n";
+ }
+ }
+ }
+ @{$r_exist_head->{$lang}}=@exist_head_each;
+ %{$r_exist_char->{$lang}}=%exist_char_each;
+ }
+ if (@lang>1) {
+ $lang = join ',', @lang;
+ @{$r_exist_head->{$lang}}=@exist_head_mul;
+ %{$r_exist_char->{$lang}}=%exist_char_mul;
+ }
+}
+
+1;