4 use vars qw($opt_in_cs $opt_out_cs $opt_help $usage
7 $char $char_id $out_char $omegadb_home
8 $ids $ids_argc %ids $idsdb
9 $idsdata_file $ids_start $font_start
12 $inotp $perl56 $perl58
13 $useCDP $useHZK $useGT
18 use Chise_utils ':all';
20 my $strictly_forbidden_after = '「【『[(〈“‘‘(〔{《{\[\(\x{3016}{「';
21 # \x{3016} | # white 【
23 my $forbidden_after = "\x{0000}";
26 my $slightly_forbidden_after = '¥¥$$〒♯##¢¢££@@§';
28 # $strictly_forbidden_before
29 # All these characters are allowed to protrude
31 my $strictly_forbidden_before=
32 '!,.:;?、。!,.:;?。\)#}’”〉》」』】〕\x{3017})]}}」\]';
33 # \x{3017} | # white 】
36 = 'ー々ぁぃぅぇぉゃゅょっゎァィゥェォャュョッヮヵヶ';
38 my $slightly_forbidden_before
39 = '\x{000a}\#\-‐−‰′″℃゛゜ゝゞヽヾ"%-゙゚';
41 my $asian = '\x{1100}-\x{11FF}\x{2E80}-\x{D7AF}\x{F900}-\x{FAFF}\x{FE30}-\x{FE4F}\x{FF00}-';
43 my $space = '\x{0020}\x{0009}\x{000A}\x{000C}\x{000D}';
49 if($^V and $^V ge v5.8){
51 }elsif($^V and $^V ge v5.6){
54 print STDERR "This versin is not supported.";
58 binmode(STDIN, ':encoding(utf8)');
59 binmode(STDOUT, ':encoding(utf8)');
62 $omegadb_home="/Users/izumi/.chise";
64 &GetOptions("in=s"=>\$opt_in_cs,
66 "out=s"=>\$opt_out_cs,
72 Usage: $0 -i <input coding system> -o <cmap encoding>
74 Utf8mcs, Utf8cns, Utf8gb, Utf8jis, Utf8ks
76 UniCNS, UniGB, UniJIS, UniKS
79 if($opt_in_cs or $opt_out_cs){
83 ($in_cs,$out_cs)=($0=~/(Utf8.+)To(\w+)/);
88 # utf-8-mcs,utf-8-cns,utf-8-gb,utf-8-jis,utf-8-ks,
90 # UniCNS,UniGB,UniJIS,UniKS
93 or not defined($in_cs)
94 or not defined($out_cs)){
99 $idsdata_file="idsdata.pl";
103 if(-e $idsdata_file){
104 require $idsdata_file;
111 "=gt-pj-1","=gt-pj-2","=gt-pj-3","=gt-pj-4","=gt-pj-5","=gt-pj-6","=gt-pj-7","=gt-pj-8","=gt-pj-9","=gt-pj-10","=gt-pj-11"
112 #,"=gt-pj-k1","=gt-pj-k2"
114 @HZK=("=hanziku-1","=hanziku-10","=hanziku-11","=hanziku-12","=hanziku-2","=hanziku-3","=hanziku-4","=hanziku-5","=hanziku-6","=hanziku-7","=hanziku-8","=hanziku-9");
118 # temporary fix for using in OTP for perl 5.6.
119 s/(.)/pack("c",unpack("U",$1))/ge if($inotp
123 $_=decode('utf8', $_) if ($inotp and $in_cs=~/utf8/i
125 s/(amp.+?;)/&tex_de_er($1)/ge;
126 # s/(&.+?;)/&tex_de_er($1)/ge;
127 # s/^(.*)$/&add_break($1)/e;
129 for($i=0;$i<=$#chars;$i++){
131 $char=&get_char_in_utf8mcs($chars[$i],$in_cs);
132 $char_id=unpack("U",$char);
135 ($ids,$ids_argc)=&ids_rest($ids,$ids_argc,$char);
137 if(($char_id=&get_char_id_for_ids($ids))
138 and(($out_char=&get_output_char($char_id,$out_cs)))){
139 print $out_char,&add_break($i);
141 print &replace_ids($ids),&add_break($i) if($perl56);
142 print encode('utf8', &replace_ids($ids)),&add_break($i) if($perl58);
146 }elsif($char_id>=0x2ff0 and $char_id<=0x2fff){
147 ($ids,$ids_argc)=&ids_rest("",0,$char);
154 if(($out_char=&get_output_char($char_id,$out_cs))){
155 print $out_char,&add_break($i);
156 }elsif($char_id >= 0x20000 && $char_id <=0x2a6df){
157 unless(defined($ids{$char}) and $ids{$char}[1]>=0){
158 $ids{$char}[0]=$font_start;
159 $ids{$char}[1]=$ids_start;
166 print "{\\fontencoding{OT1}\\fontfamily{" .
167 sprintf("chise%03d",$ids{$char}[0]) .
168 "}\\selectfont\\char$ids{$char}[1]}",&add_break($i);
171 print &replace_ids(&get_ids($char)),&add_break($i);
176 print STDERR "IDS parse error: $ids\n";
177 # print pack("U",0xfffd);
178 print pack("U",0x3013) if($perl56);
179 print encode('utf8',pack("U",0x3013)) if($perl58);
185 open(IDSDATA,">$idsdata_file") or die;
186 print IDSDATA 'use utf8;',"\n";
187 foreach $ids (keys %ids){
188 print IDSDATA '$ids{\'',$ids,'\'}=[',join ",",@{$ids{$ids}},"];\n" if($perl56);
189 print IDSDATA '$ids{\'',encode('utf8',$ids),'\'}=[',join ",",@{$ids{$ids}},"];\n" if($perl58);
191 print IDSDATA '$font_start=',$font_start,";\n";
192 print IDSDATA '$ids_start=',$ids_start,";\n";
200 $er=~s/^amp(.*);$/$1/;
201 # $er=~s/^&(.*);$/$1/;
214 if(($chars[$i+1]=~m/[$strictly_forbidden_before]/o)
215 and($chars[$i+2]=~m/[$strictly_forbidden_before]/o)){
216 return "\\CJKunbreakablekernone ";
217 }elsif(($chars[$i+1]=~m/[$strictly_forbidden_before]/o)
218 and($chars[$i+2]=~m/[^$strictly_forbidden_before]/o)){
219 return "\\CJKunbreakablekernone \\CJKprotrude ";
223 and($chars[$i+1]=~m/[$strictly_forbidden_before]/o)){
224 return "\\CJKunbreakablekernone ";
226 if($chars[$i]=~m/[$strictly_forbidden_after]/o){
227 return "\\CJKunbreakablekernone ";
230 and($chars[$i+1]=~m/[$forbidden_before]/o)){
231 return "\\CJKunbreakablekerntwo ";
234 if($chars[$i]=~m/[$forbidden_after]/o){
235 return "\\CJKunbreakablekerntwo ";
238 and($chars[$i+1]=~m/[$slightly_forbidden_before]/o)){
239 return "\\CJKunbreakablekernthree ";
241 if($chars[$i]=~m/[$slightly_forbidden_after]/o){
242 return "\\CJKunbreakablekernthree ";
244 if($chars[$i]=~m/[$asian]/o){
245 return "\\CJKbreakablekern ";
247 if(($i<$#chars)and($chars[$i+1]=~m/[$asian]/o)){
248 return "\\CJKbreakablekern ";
253 my($ids,$ids_argc,$char)=@_;
255 $argc=&ids_argc($char);
257 $ids_argc+= $ids_argc==0 ? $argc : $argc-1;
261 $ids.=$char if($perl56);
262 $ids.=encode('utf8',$char) if($perl58);
263 return ($ids,$ids_argc);
268 $ids=&normalize_ids($ids,"UniJIS");
269 # return pack("U",0xfffd) if($ids!~/[$idc]/);
270 return pack("U",0x3013) if(($ids!~/[$idc]/)
271 or($ids=~/[\x{10000}-]/));
273 unless(defined($ids{$ids}) and $ids{$ids}[1]>=0){
274 $ids{$ids}[0]=$font_start;
275 $ids{$ids}[1]=$ids_start;
282 return "{\\fontencoding{OT1}\\fontfamily{".sprintf("chise%03d",$ids{$ids}[0])."}\\selectfont\\char$ids{$ids}[1]}";
287 $ids = decode('utf8', $ids) if $perl58;
288 $out_cs=~s/Uni(.+)/"ucs-".lc($1)/e;
290 my($char,$char_id,$output_char_id);
291 while($ids=~m/(.)/g){
293 $char_id=unpack("U",$char);
296 }elsif($output_char_id=&get_char_attribute($char,$out_cs)){
297 $output_ids.=pack("U",$output_char_id);
298 }elsif($output_char_id=&get_char_attribute($char,"=ucs")){
299 $output_ids.=pack("U",$output_char_id);
300 }elsif($output_char_id=&get_char_attribute($char,"ucs")){
301 $output_ids.=pack("U",$output_char_id);
303 return pack("U",0xfffe);
310 my($char_id,$out_cs)=@_;
311 my($out_char_id,$suffix);
313 if(not defined($cmap_to{$out_cs})){
316 if($out_char_id=$cmap_to{$out_cs}->{$char_id}){
317 return pack("U",$out_char_id);
319 return $gt if($useGT and $gt=&get_macro_for_GT($char_id));
320 return $hzk if($useHZK and $hzk=&get_macro_for_HZK($char_id));
321 return $cdp if($useCDP and $cdp=&get_macro_for_CDP($char_id));
328 tie %{$cmap_to{$out_cs}}, "BerkeleyDB::Hash",
329 -Filename => "$omegadb_home/$out_cs" or die $!;
335 $ids=&get_char_attribute($char,"ids-aggregated")
336 or &get_char_attribute($char,"ids");
337 # or &get_char_attribute($char,"ideographic-structure");
338 $ids=decode('utf8', $ids) if($perl58);
343 sub get_char_id_for_ids{
346 $ids=decode('utf8', $ids) if($perl58);
347 # $ids="(?".(join " ?",(split(//,$ids))).")";
348 &get_idsdb if(not defined($idsdb));
349 $char=$idsdb->{$ids};
350 $char=decode('utf8',$char) if($perl58);
352 return unpack("U",$char);
359 tie %{$idsdb}, "BerkeleyDB::Hash",
360 -Filename => "$omegadb_home/idsdb" or die $!;
363 sub get_char_in_utf8mcs_bak{
365 return $char if($in_cs eq "Utf8mcs");
366 my($char_id,$output_char);
367 $in_cs=~s/Utf8/ucs-/;
368 $char_id=unpack("U",$char);
369 if(($output_char)=&get_chars_matching("$in_cs",$char_id)){
370 $output_char=decode('utf8', $output_char) if($perl58);
377 sub get_char_in_utf8mcs{
378 # argument: <character>, <input coding system>
379 # return: character in UTF-8mcs.
381 my($char_id,$output_char_id);
382 return $char if($in_cs eq "Utf8mcs");
383 $char_id=unpack("U",$char);
384 &get_utf8mcs_map($in_cs) if(not defined($utf8mcs_map_from{$in_cs}));
385 if($output_char_id=$utf8mcs_map_from{$in_cs}->{$char_id}){
386 return pack("U",$output_char_id);
395 ($suffix=$in_cs)=~s/^Utf8//;
396 tie %{$utf8mcs_map_from{$in_cs}}, "BerkeleyDB::Hash",
397 -Filename => "$omegadb_home/ucs-$suffix" or die $!;
400 sub get_macro_for_GT{
403 $char=pack("U",$char_id);
405 if($gt=&get_char_attribute($char,$_)){
406 m/gt\-pj\-(\d+)/ and $GT=$1;
411 return "{\\fontencoding{OT1}\\fontfamily{".sprintf("gt%02d",$GT)."}\\selectfont\\char".($gt|0x8080)."}";
412 # return "\\GT{".sprintf("gt%02d",$GT)."}{\\char".($gt|0x8080)."}";
418 sub get_macro_for_HZK{
421 $char=pack("U",$char_id);
423 if($hzk=&get_char_attribute($char,$_)){
424 m/hanziku\-(\d+)/ and $HZK=$1;
429 return "{\\fontencoding{OT1}\\fontfamily{".sprintf("hzk%02d",$HZK)."}\\selectfont\\char".($hzk|0x8080)."}";
435 sub get_macro_for_CDP{
438 $char=pack("U",$char_id);
440 if($cdp=&get_char_attribute($char,$_)){
445 return "{\\fontencoding{OT1}\\fontfamily{cdp}\\selectfont\\char".($cdp|0x8080)."}";