1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
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;
|