annotate ucs2jis.pm @ 0:a6ddaa18e3c1

k14 unicode font kit
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sat, 15 Jun 2013 12:23:00 +0900
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
1 #!/usr/bin/perl
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
2 #
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
3 # 309 19:56 xfd -fn '-Misc-Fixed-Medium-R-Normal-ja-13-120-75-75-C-120-ISO10646-1'
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
4
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
5 use NKF;
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
6
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
7 sub to_ucs
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
8 {
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
9 # my $jis_no = 0x3126;
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
10 my ($jis_no) = @_;
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
11
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
12 my $jis = chr($jis_no/256+0x80).chr($jis_no%256+0x80);
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
13 # print $jis,"\n";
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
14
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
15 my $ucs = nkf("-E","-w16",$jis);
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
16 # print length($ucs),"\n";
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
17
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
18 my $ucs_no = ord(substr($ucs,0,1))*256+ord(substr($ucs,1,1));
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
19
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
20 # print "HEX:",unpack("H*",$ucs),"\n";
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
21
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
22 return $ucs_no
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
23 }
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
24
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
25 sub to_jis
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
26 {
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
27 my ($ucs_no) = @_;
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
28
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
29 my $ucs = chr($ucs_no/256).chr($ucs_no%256);
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
30 # print $jis,"\n";
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
31
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
32 my $jis = nkf("-W16","-e",$ucs);
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
33 # print length($ucs),"\n";
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
34
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
35 my $jis_no = (ord(substr($jis,0,1))-0x80)*256+
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
36 ord(substr($jis,1,1))-0x80;
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
37
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
38 # print "HEX:",unpack("H*",$ucs),"\n";
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
39 return undef if ($jis_no==-32896);
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
40 return $jis_no
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
41 }
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
42
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
43 # printf "%x\n", &to_ucs(0x3126);
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
44 # printf "%x\n", &to_jis(0x53f3);
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
45
a6ddaa18e3c1 k14 unicode font kit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
46 1;