X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=outCMAP;h=dd9411dbe86998d47fe2c6c95265bac8db3ed31d;hb=827143b24183bd8c3362d25e5b39ff6932ede2d9;hp=9bc884151214542264b465dd7938ed9a8fc95cf0;hpb=03dde047de06a76082c327d975e14cf52915470d;p=chise%2Fomega.git diff --git a/outCMAP b/outCMAP index 9bc8841..dd9411d 100755 --- a/outCMAP +++ b/outCMAP @@ -1,162 +1,58 @@ #!/usr/bin/perl +# ver.0.2 + use strict; -use vars qw($opt_in_cs $opt_out_cs $opt_help $usage - $in_cs $out_cs - $i @chars - $char $char_id $out_char $omegadb_home +use vars qw($omegadb_path + $opt_protrude $opt_order + $opt_in_cs $opt_out_cs + $opt_help $usage + $in_cs $out_cs $i @chars + @order %order + $char $char_id $out_char $ids $ids_argc %ids $idsdb $idsdata_file $ids_start $font_start - %utf8mcs_map_from - %cmap_to $inotp $perl56 $perl58 - $useCDP $useHZK $useGT @CDP @HZK @GT ); use Getopt::Long; use utf8; +use Fcntl ':flock'; use Chise_utils ':all'; -my $strictly_forbidden_after = " - \x{0028} | - \x{005B} | - \x{007B} | - \x{2018} | - \x{201C} | - \x{3008} | - \x{300A} | - \x{300C} | - \x{300E} | - \x{3010} | - \x{3014} | - \x{3016} | - \x{FF08} | - \x{FF08} | - \x{FF3B} | - \x{FF5B} | - \x{FF5B} | - \x{FF62} -"; +my $omegadb_path="/usr/local/lib/chise/omega"; + +### Options ### + +$opt_order='jcgk'; +#$opt_order='jtcgkhd'; +$opt_protrude=0;# 1=true, 0=false. + +### +my $strictly_forbidden_after = '「【『［（〈“‘‘（〔｛《{\[\(\x{3016}｛｢'; +# \x{3016} | # white 【 my $forbidden_after = "\x{0000}"; # ￥¥＄$〒♯＃#￠¢￡£＠@§ -my $slightly_forbidden_after = " - \x{FFE5} | - \x{00A5} | - \x{FF04} | - \x{0024} | - \x{3012} | - \x{266F} | - \x{FF03} | - \x{0023} | - \x{FFE0} | - \x{00A2} | - \x{FFE1} | - \x{00A3} | - \x{FF20} | - \x{0040} | - \x{00A7} -"; +my $slightly_forbidden_after = '￥¥＄$〒♯＃#￠¢￡£＠@§'; +# $strictly_forbidden_before # All these characters are allowed to protrude # in the right margin -my $strictly_forbidden_before = " - \x{0021} | # ! - \x{002c} | # , - \x{002e} | # . - \x{003a} | # : - \x{003b} | # ; - \x{003f} | # ? - \x{3001} | # 、 - \x{3002} | # 。 - \x{ff01} | # ！ - \x{ff0c} | # ， - \x{ff0e} | # ． - \x{ff1a} | # ： - \x{ff1b} | # ； - \x{ff1f} | # ？ - \x{ff61} | # 。 - \x{0029} | # ) -# \x{005d} | # ] - \x{007d} | # } - \x{2019} | # ’ - \x{201d} | # ” - \x{3009} | # 〉 - \x{300b} | # 》 - \x{300d} | # 」 - \x{300f} | # 』 - \x{3011} | # 】 - \x{3015} | # 〕 - \x{3017} | # white 】 - \x{ff09} | # ） - \x{ff3d} | # ］ - \x{ff5d} | # ｝ - \x{ff5d} | # ｝ - \x{ff63} # 」 -"; - -my $forbidden_before = " - \x{30fc} | # ー - \x{3005} | # 々 - \x{3041} | # ぁ - \x{3043} | # ぃ - \x{3045} | # ぅ - \x{3047} | # ぇ - \x{3049} | # ぉ - \x{3083} | # ゃ - \x{3085} | # ゅ - \x{3087} | # ょ - \x{3063} | # っ - \x{308e} | # ゎ - \x{30a1} | # ァ - \x{30a3} | # ィ - \x{30a5} | # ゥ - \x{30a7} | # ェ - \x{30a9} | # ォ - \x{30e3} | # ャ - \x{30e5} | # ュ - \x{30e7} | # ョ - \x{30c3} | # ッ - \x{30ee} | # ヮ - \x{30f5} | # ヵ - \x{30f6} # ヶ -"; - -# \- | # - - -my $slightly_forbidden_before = " - \x{000a} | # ??? - \# | # # - \x{2010} | # ‐ - \x{2012} | # − - \x{2030} | # ‰ - \x{2032} | # ′ - \x{2033} | # ″ - \x{2103} | # ℃ - \x{309b} | # ゛ - \x{309c} | # ゜ - \x{309d} | # ゝ - \x{309e} | # ゞ - \x{30fd} | # ヽ - \x{30fe} | # ヾ - \x{ff02} | # ＂ - \x{ff05} | # ％ - \x{ff0d} | # － - \x{ff9e} | # ﾞ - \x{ff9f} # ﾟ -"; - -my $asian = "\x{1100}-\x{11FF} | \x{2E80}-\x{D7AF} | - \x{F900}-\x{FAFF} | \x{FE30}-\x{FE4F} | - \x{FF00}-"; - -my $space = "\x{0020} | \x{0009} | \x{000A} | \x{000C} | \x{000D} "; - - -$useGT=1; -$useHZK=0; -$useCDP=0; +my $strictly_forbidden_before= + '!,.:;?、。！，．：；？。\)#}’”〉》」』】〕\x{3017}）］｝｝」\]'; +### \x{3017} | # white 】 + +my $forbidden_before + = 'ー々ぁぃぅぇぉゃゅょっゎァィゥェォャュョッヮヵヶ'; + +my $slightly_forbidden_before + = '\x{000a}\#\-‐−‰′″℃゛゜ゝゞヽヾ＂％－ﾞﾟ'; + +my $asian = '\x{1100}-\x{11FF}\x{2E80}-\x{D7AF}\x{F900}-\x{FAFF}\x{FE30}-\x{FE4F}\x{FF00}-'; + +my $space = '\x{0020}\x{0009}\x{000A}\x{000C}\x{000D}'; if($^V and $^V ge v5.8){ $perl58=1; @@ -164,6 +60,7 @@ if($^V and $^V ge v5.8){ $perl56=1; }else{ print STDERR "This versin is not supported."; + exit 1; } if($perl58){ eval "use Encode"; @@ -171,21 +68,16 @@ if($perl58){ binmode(STDOUT, ':encoding(utf8)'); } -$omegadb_home="/Users/izumi/.chise"; - &GetOptions("in=s"=>\$opt_in_cs, - "i=s"=>\$opt_in_cs, "out=s"=>\$opt_out_cs, - "o=s"=>\$opt_out_cs, - "help",\$opt_help, - "h",\$opt_help); + "help",\$opt_help); $usage=< -o input coding system: Utf8mcs, Utf8cns, Utf8gb, Utf8jis, Utf8ks cmap encoding: - UniCNS, UniGB, UniJIS, UniKS + UniCNS, UniGB, UniJIS, UniKS, UniMulti EOF if($opt_in_cs or $opt_out_cs){ @@ -197,9 +89,11 @@ if($opt_in_cs or $opt_out_cs){ } # $in_cs: -# utf-8-mcs,utf-8-cns,utf-8-gb,utf-8-jis,utf-8-ks, +# Utf8mcs,Utf8cns,Utf8gb,Utf8jis,Utf8ks, # $out_cs: -# UniCNS,UniGB,UniJIS,UniKS +# UniCNS,UniGB,UniJIS,UniKS,UniMulti + +$in_cs=~s/Utf8/ucs\@/; if($opt_help or not defined($in_cs) @@ -208,12 +102,25 @@ if($opt_help exit 1; } -$idsdata_file="idsdata.pl"; +$omegadb_path=~s!/$!!; + +$idsdata_file="$omegadb_path/idsdata.pl"; $ids_start=0x00; $font_start=0; if(-e $idsdata_file){ - require $idsdata_file; + open(IDSDATA,"+<$idsdata_file") or die; + flock(IDSDATA,LOCK_EX); + seek(IDSDATA,0,0); + while(){ + eval $_; + } + seek(IDSDATA,0,0); +# require $idsdata_file; +}else{ + open(IDSDATA,">$idsdata_file") or die; + flock(IDSDATA,LOCK_EX); + seek(IDSDATA,0,0); } $ids_argc=0; @@ -223,50 +130,69 @@ $ids=""; "=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" #,"=gt-pj-k1","=gt-pj-k2" ); -@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"); +@HZK=("=hanziku-1","=hanziku-2","=hanziku-3","=hanziku-4","=hanziku-5","=hanziku-6","=hanziku-7","=hanziku-8","=hanziku-9","=hanziku-10","=hanziku-11","=hanziku-12"); @CDP=("=big5-cdp"); +%order=('c'=>'UniCNS', + 'g'=>'UniGB', + 'j'=>'UniJIS', + 'k'=>'UniKS', + 't'=>'GT', + 'h'=>'HZK', + 'd'=>'CDP', + ); + +if(defined($opt_order)){ + if($opt_order=~/^[cgjkthd]*$/){ + @order=split(//,$opt_order); + @order=map {$order{$_}} @order; + }else{ + print STDERR "Invalid order!\n"; + exit 1; + } +} + while(<>){ - # temporary fix for using in OTP for perl 5.6. - s/(.)/pack("c",unpack("U",$1))/ge if($inotp - and $in_cs=~/utf8/i - and $perl56); - # for perl 5.8. - $_=decode('utf8', $_) if ($inotp and $in_cs=~/utf8/i - and $perl58); - s/(amp.+?;)/&tex_de_er($1)/ge; -# s/(&.+?;)/&tex_de_er($1)/ge; -# s/^(.*)$/&add_break($1)/e; + if($perl56){ + # for perl 5.6 + if($inotp){ + s/(.)/pack("c",&get_char_id(unpack("U",$1),$in_cs))/ge; + }else{ + s/(.)/pack("U",&get_char_id(unpack("U",$1),$in_cs))/ge; + } + }elsif($perl58){ + # for perl 5.8. + $_=decode('utf8', $_); + s/(.)/pack("U",&get_char_id(unpack("U",$1),$in_cs))/ge; + } + s/(amp.+?;)/&de_er($1)/ge; +# s/(&.+?;)/&de_er($1)/ge; @chars=split(//); for($i=0;$i<=$#chars;$i++){ -# while(m/(.)/g){ - $char=&get_char_in_utf8mcs($chars[$i],$in_cs); + $char=$chars[$i]; $char_id=unpack("U",$char); - if($ids_argc>0){ - # It's in IDS. - ($ids,$ids_argc)=&ids_rest($ids,$ids_argc,$char); - if($ids_argc==0){ - if(($char_id=&get_char_id_for_ids($ids)) - and(($out_char=&get_output_char($char_id,$out_cs)))){ - print $out_char,&add_break($i); - }else{ - print &replace_ids($ids),&add_break($i) if($perl56); - print encode('utf8', &replace_ids($ids)),&add_break($i) if($perl58); - } - $ids=""; - } + + if($char_id<=0x20){ + print $chars[$i]; + next; + }elsif($char_id>0x20 and $char_id<=0x02af){ + # Basic Latin + # Latin-1 Supplement + # Latin Extended-A + # Latin Extended-B + # IPA Extensions + print &latin_parse(); + next; }elsif($char_id>=0x2ff0 and $char_id<=0x2fff){ - ($ids,$ids_argc)=&ids_rest("",0,$char); + # Ideographic Description Characters + print &ids_parse(); next; }else{ - if($char_id<=0xff){ - print $char; - next; - } if(($out_char=&get_output_char($char_id,$out_cs))){ print $out_char,&add_break($i); }elsif($char_id >= 0x20000 && $char_id <=0x2a6df){ - unless(defined($ids{$char}) and $ids{$char}[1]>=0){ + # CJK Unified Ideographs Extension B + if(not defined($ids{$char}) and $ids{$char}[1]>=0){ $ids{$char}[0]=$font_start; $ids{$char}[1]=$ids_start; $ids_start++; @@ -280,21 +206,16 @@ while(<>){ "}\\selectfont\\char$ids{$char}[1]}",&add_break($i); next; }else{ - print &replace_ids(&get_ids($char)),&add_break($i); + if($ids=&get_ids($char)){ + print &get_macro_for_ids($ids),&add_break($i); + }else{ + print '\rule{1ex}{1ex}',&add_break($i); + } } } } - if($ids_argc>0){ - print STDERR "IDS parse error: $ids\n"; -# print pack("U",0xfffd); - print pack("U",0x3013) if($perl56); - print encode('utf8',pack("U",0x3013)) if($perl58); - $ids=""; - $ids_argc=0; - } } -open(IDSDATA,">$idsdata_file") or die; print IDSDATA 'use utf8;',"\n"; foreach $ids (keys %ids){ print IDSDATA '$ids{\'',$ids,'\'}=[',join ",",@{$ids{$ids}},"];\n" if($perl56); @@ -303,78 +224,105 @@ foreach $ids (keys %ids){ print IDSDATA '$font_start=',$font_start,";\n"; print IDSDATA '$ids_start=',$ids_start,";\n"; print IDSDATA "1;"; +flock(IDSDATA,LOCK_UN); exit 0; -sub tex_de_er{ - my($er)=@_; - my($out); - $er=~s/^amp(.*);$/$1/; -# $er=~s/^&(.*);$/$1/; - $out=&de_er($er); - if($out){ - return $out; - }else{ - return "amp$er;"; - } -} - sub add_break{ my($i)=@_; -# $line=~s/(.)($strictly_forbidden_before)($not_strictly_forbidden_before)/ -# $1."\\CJKunbreakablekernone \\CJKprotrude ".$2.$3/egx; -# $line=~s/(.)($strictly_forbidden_before)($strictly_forbidden_before)/ -# $1."\\CJKunbreakablekernone ".$2.$3/egx; - -# $line=~s/(.)($strictly_forbidden_before)/ -# $1."\\CJKunbreakablekernone ".$2/egx; -# $line=~s/(.)($forbidden_before)/ -# $1."\\CJKunbreakablekerntwo ".$2/egx; -# $line=~s/(.)($slightly_forbidden_before)/ -# $1."\\CJKunbreakablekernthree ".$2/egx; - -# $line=~s/($forbidden_after)(.)/ -# $1."\\CJKunbreakablekerntwo ".$2/egx; -# $line=~s/($strictly_forbidden_after)(. )/ -# $1."\\CJKunbreakablekernone ".$2/egx; -# $line=~s/($slightly_forbidden_after)(.)/ -# $1."\\CJKunbreakablekernthree ".$2/egx; - -# $line=~s/($asian)(.)/$1\\CJKbreakablekern $2/g; -# $line=~s/(.)($asian)/$1\\CJKbreakablekern $2/g; - - if($i<$#chars){ - if($i<($#chars-1)){ - if(($chars[$i+1]=~m/[$strictly_forbidden_before]/x) - and($chars[$i+2]=~m/[^$strictly_forbidden_before]/x)){ + if($i<($#chars-1)){ + if(($chars[$i+1]=~m/[$strictly_forbidden_before]/o) + and($chars[$i+2]=~m/[$strictly_forbidden_before]/o)){ + return "\\CJKunbreakablekernone "; + }elsif($opt_protrude){ + if(($chars[$i+1]=~m/[$strictly_forbidden_before]/o) + and($chars[$i+2]=~m/[^$strictly_forbidden_before]/o)){ return "\\CJKunbreakablekernone \\CJKprotrude "; - }elsif(($chars[$i+1]=~m/[$strictly_forbidden_before]/x) - and($chars[$i+2]=~m/[$strictly_forbidden_before]/x)){ - return "\\CJKunbreakablekernone "; } + } + } + if(($i<$#chars) + and($chars[$i+1]=~m/[$strictly_forbidden_before]/o)){ + return "\\CJKunbreakablekernone "; + } + if($chars[$i]=~m/[$strictly_forbidden_after]/o){ + return "\\CJKunbreakablekernone "; + } + if(($i<$#chars) + and($chars[$i+1]=~m/[$forbidden_before]/o)){ + return "\\CJKunbreakablekerntwo "; + + } + if($chars[$i]=~m/[$forbidden_after]/o){ + return "\\CJKunbreakablekerntwo "; + } + if(($i<$#chars) + and($chars[$i+1]=~m/[$slightly_forbidden_before]/o)){ + return "\\CJKunbreakablekernthree "; + } + if($chars[$i]=~m/[$slightly_forbidden_after]/o){ + return "\\CJKunbreakablekernthree "; + } + if($chars[$i]=~m/[$asian]/o){ + return "\\CJKbreakablekern "; + } + if(($i<$#chars)and($chars[$i+1]=~m/[$asian]/o)){ + return "\\CJKbreakablekern "; + } +} + +sub latin_parse{ + # arguments: none + # return: string for output with TeX macro. + my($char_id); + my $out_str=$chars[$i]; + $i++; + while($i<=$#chars){ + $char_id=unpack("U",$chars[$i]); + if($char_id>0x20 and $char_id<=0x02af){ + $out_str.=pack("U",$char_id); }else{ - if($chars[$i+1]=~m/[$strictly_forbidden_before]/x){ - return "\\CJKunbreakablekernone "; - }elsif($chars[$i+1]=~m/[$forbidden_before]/x){ - return "\\CJKunbreakablekerntwo "; - }elsif($chars[$i+1]=~m/[$slightly_forbidden_before]/x){ - return "\\CJKunbreakablekernthree "; - } + $i--; + last; } - }elsif($i>0){ - if($chars[$i]=~m/[$forbidden_after]/x){ - return "\\CJKunbreakablekerntwo "; - }elsif($chars[$i]=~m/[$strictly_forbidden_after]/x){ - return "\\CJKunbreakablekernone "; - }elsif($chars[$i]=~m/[$slightly_forbidden_after]/x){ - return "\\CJKunbreakablekernthree "; + $i++; + } + return '{\normalfont {'.$out_str.'}}'; +} + +sub ids_parse{ + # arguments: none + # return: character for output, + # TeX macro for ids, + # or GETA character if ids is invalid. + my($ids,$ids_argc)=&ids_rest("",0,$chars[$i]); + + while($ids_argc>0){ + # We are in IDS. + $i++; + if($i>$#chars){ + print STDERR "IDS parse error: $ids\n"; +# return pack("U",0xfffd); + return pack("U",0x3013); + } + + ($ids,$ids_argc)=&ids_rest($ids,$ids_argc,$chars[$i]); + if($ids_argc==0){ + if(($char_id=&get_char_id_for_ids($ids)) + and($out_char=&get_output_char($char_id,$out_cs))){ + return $out_char; + }else{ + return &get_macro_for_ids($ids) if($perl56); + return encode('utf8', &get_macro_for_ids($ids)) if($perl58); + } } } - return "\\CJKbreakablekern "; } sub ids_rest{ + # arguments: , , + # return: ids and rest number of arguments for ids. my($ids,$ids_argc,$char)=@_; my($argc); $argc=&ids_argc($char); @@ -388,14 +336,17 @@ sub ids_rest{ return ($ids,$ids_argc); } -sub replace_ids{ +sub get_macro_for_ids{ + # argument: + # return: TeX macro for ids + # or GETA character if ids is invalid for KAGE. my($ids)=@_; $ids=&normalize_ids($ids,"UniJIS"); -# return pack("U",0xfffd) if($ids!~/[$idc]/); +# return pack("U",0xfffd) if(($ids!~/[$idc]/) return pack("U",0x3013) if(($ids!~/[$idc]/) or($ids=~/[\x{10000}-]/)); #irregular for KAGE. - unless(defined($ids{$ids}) and $ids{$ids}[1]>=0){ + if(not defined($ids{$ids}) and $ids{$ids}[1]>=0){ $ids{$ids}[0]=$font_start; $ids{$ids}[1]=$ids_start; $ids_start++; @@ -404,13 +355,18 @@ sub replace_ids{ $ids_start=0; $font_start++; } - return "{\\fontencoding{OT1}\\fontfamily{".sprintf("chise%03d",$ids{$ids}[0])."}\\selectfont\\char$ids{$ids}[1]}"; + return "{\\fontencoding{OT1}\\fontfamily{" + .sprintf("chise%03d",$ids{$ids}[0]) + ."}\\selectfont\\char$ids{$ids}[1]}"; } sub normalize_ids{ + # argument: , + # return: ids or GETA character if ids is invalid for KAGE. my($ids,$out_cs)=@_; $ids = decode('utf8', $ids) if $perl58; - $out_cs=~s/Uni(.+)/"ucs-".lc($1)/e; + $out_cs=~s/Uni(.+)/'ucs@'.lc($1)/e; + my $output_ids=""; my($char,$char_id,$output_char_id); while($ids=~m/(.)/g){ @@ -418,111 +374,159 @@ sub normalize_ids{ $char_id=unpack("U",$char); if($char=~/[$idc]/){ $output_ids.=$char; - }elsif($output_char_id=&get_char_attribute($char,$out_cs)){ + }elsif($output_char_id=&get_char_attribute($char,"=$out_cs")){ $output_ids.=pack("U",$output_char_id); }elsif($output_char_id=&get_char_attribute($char,"=ucs")){ $output_ids.=pack("U",$output_char_id); - }elsif($output_char_id=&get_char_attribute($char,"ucs")){ - $output_ids.=pack("U",$output_char_id); }else{ - return pack("U",0xfffe); +# return pack("U",0xfffd); + return pack("U",0x3013); } } return $output_ids; } sub get_output_char{ + # argument: + # return: character in output coding system or TeX macro. my($char_id,$out_cs)=@_; - my($out_char_id,$suffix); + my($char,$out_char_id,$suffix); my($gt,$hzk,$cdp); - if(not defined($cmap_to{$out_cs})){ - &get_cmap($out_cs); - } - if($out_char_id=$cmap_to{$out_cs}->{$char_id}){ - return pack("U",$out_char_id); - }else{ - return $gt if($useGT and $gt=&get_macro_for_GT($char_id)); - return $hzk if($useHZK and $hzk=&get_macro_for_HZK($char_id)); - return $cdp if($useCDP and $cdp=&get_macro_for_CDP($char_id)); - return undef; - } -} -sub get_cmap{ - my($out_cs)=@_; - tie %{$cmap_to{$out_cs}}, "BerkeleyDB::Hash", - -Filename => "$omegadb_home/$out_cs" or die $!; + $char=pack('U',$char_id); + + if($out_cs eq 'UniJIS' + and &get_char_attribute($char,"vnd-adobe-cid-unijis-utf16-h")){ + if($out_char_id=&get_char_attribute($char,'=ucs@jis') + or $out_char_id=&get_char_attribute($char,'=ucs') + or $out_char_id=&get_char_attribute($char,'=>ucs@jis') + or $out_char_id=&get_char_attribute($char,'=>ucs') + ){ + return pack("U",$out_char_id); + } + }elsif($out_cs eq 'UniGB' + and &get_char_attribute($char,"vnd-adobe-cid-unigb-ucs2-h")){ + if($out_char_id=&get_char_attribute($char,'=ucs@gb') + or $out_char_id=&get_char_attribute($char,'=ucs') + or $out_char_id=&get_char_attribute($char,'=>ucs@gb') + or $out_char_id=&get_char_attribute($char,'=>ucs') + ){ + return pack("U",$out_char_id); + } + }elsif($out_cs eq 'UniCNS' + and &get_char_attribute($char,"vnd-adobe-cid-unicns-ucs2-h")){ + if($out_char_id=&get_char_attribute($char,'=ucs@cns') + or $out_char_id=&get_char_attribute($char,'=ucs') + or $out_char_id=&get_char_attribute($char,'=>ucs@cns') + or $out_char_id=&get_char_attribute($char,'=>ucs') + ){ + return pack("U",$out_char_id); + } + }elsif($out_cs eq 'UniKS' + and &get_char_attribute($char,"vnd-adobe-cid-uniks-ucs2-h")){ + if($out_char_id=&get_char_attribute($char,'=ucs@ks') + or $out_char_id=&get_char_attribute($char,'=ucs') + or $out_char_id=&get_char_attribute($char,'=>ucs@ks') + or $out_char_id=&get_char_attribute($char,'=>ucs') + ){ + return pack("U",$out_char_id); + } + }elsif($out_cs eq 'UniMulti'){ + foreach $out_cs (@order){ + + if($out_cs eq 'UniJIS' + and &get_char_attribute($char,"vnd-adobe-cid-unijis-utf16-h")){ + if($out_char_id=&get_char_attribute($char,'=ucs@jis') + or $out_char_id=&get_char_attribute($char,'=ucs') + or $out_char_id=&get_char_attribute($char,'=>ucs@jis') + or $out_char_id=&get_char_attribute($char,'=>ucs') + ){ + return '{\selectjisfont\char'.$out_char_id.'}'; + } + }elsif($out_cs eq 'UniGB' + and &get_char_attribute($char,"vnd-adobe-cid-unigb-ucs2-h")){ + if($out_char_id=&get_char_attribute($char,'=ucs@gb') + or $out_char_id=&get_char_attribute($char,'=ucs') + or $out_char_id=&get_char_attribute($char,'=>ucs@gb') + or $out_char_id=&get_char_attribute($char,'=>ucs') + ){ + return '{\selectgbsfont\char'.$out_char_id.'}'; + } + }elsif($out_cs eq 'UniCNS' + and &get_char_attribute($char,"vnd-adobe-cid-unicns-ucs2-h")){ + if($out_char_id=&get_char_attribute($char,'=ucs@cns') + or $out_char_id=&get_char_attribute($char,'=ucs') + or $out_char_id=&get_char_attribute($char,'=>ucs@cns') + or $out_char_id=&get_char_attribute($char,'=>ucs') + ){ + return '{\selectcnsfont\char'.$out_char_id.'}'; + } + }elsif($out_cs eq 'UniKS' + and &get_char_attribute($char,"vnd-adobe-cid-uniks-ucs2-h")){ + if($out_char_id=&get_char_attribute($char,'=ucs@ks') + or $out_char_id=&get_char_attribute($char,'=ucs') + or $out_char_id=&get_char_attribute($char,'=>ucs@ks') + or $out_char_id=&get_char_attribute($char,'=>ucs') + ){ + return '{\selectksxfont\char'.$out_char_id.'}'; + } + }elsif($out_cs eq 'GT'){ + return $gt if($gt=&get_macro_for_GT($char_id)); + }elsif($out_cs eq 'HZK'){ + return $hzk if($hzk=&get_macro_for_HZK($char_id)); + }elsif($out_cs eq 'CDP'){ + return $cdp if($cdp=&get_macro_for_CDP($char_id)); + } + } + } + return undef; } sub get_ids{ + # argument: + # return: ids my($char)=@_; my $ids=""; $ids=&get_char_attribute($char,"ids-aggregated") - or &get_char_attribute($char,"ids"); -# or &get_char_attribute($char,"ideographic-structure"); + or $ids=&get_char_attribute($char,"ids"); +# or $ids=&get_char_attribute($char,"ideographic-structure"); $ids=decode('utf8', $ids) if($perl58); # $ids=~s/[? ()]//g; return $ids; } sub get_char_id_for_ids{ + # argument: + # return: char-id my($ids)=@_; - my($char_id,$char); + my($output_char); $ids=decode('utf8', $ids) if($perl58); -# $ids="(?".(join " ?",(split(//,$ids))).")"; - &get_idsdb if(not defined($idsdb)); - $char=$idsdb->{$ids}; - $char=decode('utf8',$char) if($perl58); - if($char){ - return unpack("U",$char); + + if(($output_char)=&get_chars_matching("ids",$ids)){ + return unpack("U",$output_char); }else{ return undef; } } -sub get_idsdb{ - tie %{$idsdb}, "BerkeleyDB::Hash", - -Filename => "$omegadb_home/idsdb" or die $!; -} +sub get_char_id{ + # argument: , + # return: char-id. + my($char_id,$in_cs)=@_; + my($output_char); + + return $char_id if($in_cs eq 'ucs@mcs'); -sub get_char_in_utf8mcs_bak{ - my($char,$in_cs)=@_; - return $char if($in_cs eq "Utf8mcs"); - my($char_id,$output_char); - $in_cs=~s/Utf8/ucs-/; - $char_id=unpack("U",$char); - if(($output_char)=&get_chars_matching("$in_cs",$char_id)){ - $output_char=decode('utf8', $output_char) if($perl58); - return $output_char; + if(($output_char)=&get_chars_matching("=$in_cs",$char_id)){ + return unpack("U",$output_char); }else{ - return $char; + return $char_id; } } -sub get_char_in_utf8mcs{ - # argument: , - # return: character in UTF-8mcs. - my($char,$in_cs)=@_; - my($char_id,$output_char_id); - return $char if($in_cs eq "Utf8mcs"); - $char_id=unpack("U",$char); - &get_utf8mcs_map($in_cs) if(not defined($utf8mcs_map_from{$in_cs})); - if($output_char_id=$utf8mcs_map_from{$in_cs}->{$char_id}){ - return pack("U",$output_char_id); - }else{ - return $char; - } -} - -sub get_utf8mcs_map{ - my($in_cs)=@_; - my($suffix); - ($suffix=$in_cs)=~s/^Utf8//; - tie %{$utf8mcs_map_from{$in_cs}}, "BerkeleyDB::Hash", - -Filename => "$omegadb_home/ucs-$suffix" or die $!; -} - sub get_macro_for_GT{ + # argument: + # return: TeX macro for GT fonts. my($char_id)=@_; my($char,$gt,$GT); $char=pack("U",$char_id); @@ -533,8 +537,9 @@ sub get_macro_for_GT{ } } if($gt){ - return "{\\fontencoding{OT1}\\fontfamily{".sprintf("gt%02d",$GT)."}\\selectfont\\char".($gt|0x8080)."}"; -# return "\\GT{".sprintf("gt%02d",$GT)."}{\\char".($gt|0x8080)."}"; + return "{\\fontencoding{OT1}\\fontfamily{" + .sprintf("gt%02d",$GT) + ."}\\selectfont\\char".($gt|0x8080)."}"; }else{ return undef; } @@ -551,7 +556,7 @@ sub get_macro_for_HZK{ } } if($hzk){ - return "{\\fontencoding{OT1}\\fontfamily{".sprintf("hzk%02d",$HZK)."}\\selectfont\\char".($hzk|0x8080)."}"; + return "{\\fontencoding{OT1}\\fontfamily{".sprintf("hzk%02d",$HZK)."}\\selectfont\\char".$hzk."}"; }else{ return undef; } @@ -559,7 +564,7 @@ sub get_macro_for_HZK{ sub get_macro_for_CDP{ my($char_id)=@_; - my($char,$cdp); + my($char,$cdp,$ucs); $char=pack("U",$char_id); foreach (@CDP){ if($cdp=&get_char_attribute($char,$_)){ @@ -567,7 +572,15 @@ sub get_macro_for_CDP{ } } if($cdp){ - return "{\\fontencoding{OT1}\\fontfamily{cdp}\\selectfont\\char".($cdp|0x8080)."}"; + $ucs=&get_char_attribute(&get_chars_matching("=big5-pua",$cdp),"=ucs"); + if($ucs){ + return "{\\fontencoding{OT1}\\fontfamily{cdp}\\selectfont\\char" + .$ucs. + "}"; + }else{ + print STDERR "This hould not happen.\n"; + print STDERR "ucs code point of CDP: $cdp not found.\n"; + } }else{ return undef; }