From: imiyazaki Date: Fri, 7 Nov 2003 16:21:43 +0000 (+0000) Subject: fix $asian. X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=a4fe9b68e31228dac4b45e0d56125a963174b3d4;p=chise%2Fomega.git fix $asian. remove unnecessary pack and unpack. move some utf8::decode to Chise_utils.pm. --- diff --git a/inCHISE b/inCHISE index 2aeb780..0750906 100755 --- a/inCHISE +++ b/inCHISE @@ -1,4 +1,4 @@ -#!/usr/bin/perl -CSD +#!/usr/bin/perl -w -CSD # ver.0.2 @@ -10,8 +10,8 @@ use vars qw($omegadb_path $opt_help $usage $in_cs $out_cs $i @chars $char $char_id $out_char - $char_id_unified @char_id_unified - $ids $ids_argc %ids $idsdb + $char_unified @chars_unified + $ids $ids_argc %ids $idsdb $geta $idsdata_file $ids_start $font_start @CDP @HZK @GT ); @@ -27,8 +27,8 @@ my $omegadb_path="/usr/local/lib/chise/omega"; #$opt_order{'UniMulti'}='jcgk'; $opt_order{'UniMulti'}='jGcgkHC'; -$opt_order{'UniGB'}='g'; $opt_order{'UniCNS'}='c'; +$opt_order{'UniGB'}='g'; $opt_order{'UniJIS'}='j'; $opt_order{'UniKS'}='k'; @@ -58,7 +58,7 @@ 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 $asian = '\x{1100}-\x{11FF}\x{2E80}-\x{D7AF}\x{F900}-\x{FAFF}\x{FE30}-\x{FE4F}\x{FF00}-\x{FFFFFF}'; my $space = '\x{0020}\x{0009}\x{000A}\x{000C}\x{000D}'; @@ -119,6 +119,9 @@ if(-e $idsdata_file){ $ids_argc=0; $ids=""; +$geta=pack("U",0x3013); +#$geta=pack("U",0xfffd); + @GT=(#"=gt","=gt-k", "=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", @@ -139,7 +142,7 @@ $ids=""; 'C'=>'CDP', ); -foreach $out_cs ('UniGB','UniCNS','UniJIS','UniKS','UniMulti'){ +foreach $out_cs ('UniCNS','UniGB','UniJIS','UniKS','UniMulti'){ if(defined($opt_order{$out_cs})){ if($opt_order{$out_cs}=~/^[cgjkGHC]+$/){ @{$order{$out_cs}}=map {$order_map{$_}} @@ -154,7 +157,7 @@ foreach $out_cs ('UniGB','UniCNS','UniJIS','UniKS','UniMulti'){ while(<>){ utf8::decode($_); if($in_cs ne 'ucs@mcs'){ - s/(.)/pack("U",&get_char_id(unpack("U",$1),$in_cs))/ge; + s/(.)/&get_char_in_mcs($1,$in_cs)/ge; } s/(amp.+?;)/&de_tex_er($1)/ge; # s/(&.+?;)/&de_tex_er($1)/ge; @@ -180,7 +183,7 @@ while(<>){ print &ids_parse(); next CHAR; }else{ - if(($out_char=&get_output_char($char_id,$out_cs))){ + if(($out_char=&get_output_char($char,$out_cs))){ print $out_char,&add_break($i); }elsif($char_id >= 0x20000 && $char_id <=0x2a6df){ # CJK Unified Ideographs Extension B @@ -199,11 +202,11 @@ while(<>){ next CHAR; }else{ if($opt_allow_unify){ - @char_id_unified=&get_char_id_unified($char_id); - if(@char_id_unified>0){ - foreach $char_id_unified (@char_id_unified){ + @chars_unified=&get_chars_unified($char); + if(@chars_unified>0){ + foreach $char_unified (@chars_unified){ if(($out_char - =&get_output_char($char_id_unified,$out_cs))){ + =&get_output_char($char_unified,$out_cs))){ print $out_char,&add_break($i); next CHAR; } @@ -247,7 +250,6 @@ sub de_tex_er{ $value=hex($value); } ($output_char)=&get_chars_matching($er_alias{$atr},$value); - utf8::decode($output_char); } if($output_char){ return $output_char; @@ -331,18 +333,16 @@ sub ids_parse{ $i++; if($i>$#chars){ print STDERR "IDS parse error: $ids\n"; -# return pack("U",0xfffd); - return pack("U",0x3013); + return $geta; } ($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))){ + if(($char=&get_char_for_ids($ids)) + and($out_char=&get_output_char($char,$out_cs))){ return $out_char; }else{ return &get_macro_for_ids($ids); -# return encode('utf8', &get_macro_for_ids($ids)) if($perl58); } } } @@ -355,12 +355,11 @@ sub ids_rest{ my($argc); $argc=&ids_argc($char); if($argc){ - $ids_argc+= $ids_argc==0 ? $argc : $argc-1; + $ids_argc+=$ids_argc==0?$argc:$argc-1; }else{ $ids_argc--; } $ids.=$char; -# $ids.=encode('utf8',$char) if($perl58); return ($ids,$ids_argc); } @@ -370,9 +369,8 @@ sub get_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",0x3013) if(($ids!~/[$idc]/) - or($ids=~/[\x{10000}-]/)); + return $geta if(($ids!~/[$idc]/) + or($ids=~/[\x{10000}-]/)); #irregular for KAGE. if(not defined($ids{$ids}) and $ids{$ids}[1]>=0){ $ids{$ids}[0]=$font_start; @@ -395,33 +393,33 @@ sub normalize_ids{ $out_cs=~s/Uni(.+)/'ucs@'.lc($1)/e; my $output_ids=""; - my($char,$char_id,$output_char_id); + my($char,$output_char_id); while($ids=~m/(.)/g){ $char=$1; - $char_id=unpack("U",$char); if($char=~/[$idc]/){ $output_ids.=$char; }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,"=>$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); }else{ -# return pack("U",0xfffd); - return pack("U",0x3013); + return $geta; } } return $output_ids; } sub get_output_char{ - # argument: + # argument: # return: character in output coding system or TeX macro or undef. - my($char_id,$out_cs)=@_; - my($char,$out_char_id,$suffix); + my($char,$out_cs)=@_; + my($out_char_id,$suffix); my($gt,$hzk,$cdp); - $char=pack('U',$char_id); - foreach $out_cs (@{$order{$out_cs}}){ if($out_cs eq 'UniJIS' and &get_char_attribute($char,"vnd-adobe-cid-unijis-utf16-h")){ @@ -460,11 +458,11 @@ sub get_output_char{ return '{\selectksxfont\char'.$out_char_id.'}'; } }elsif($out_cs eq 'GT'){ - return $gt if($gt=&get_macro_for_GT($char_id)); + return $gt if($gt=&get_macro_for_GT($char)); }elsif($out_cs eq 'HZK'){ - return $hzk if($hzk=&get_macro_for_HZK($char_id)); + return $hzk if($hzk=&get_macro_for_HZK($char)); }elsif($out_cs eq 'CDP'){ - return $cdp if($cdp=&get_macro_for_CDP($char_id)); + return $cdp if($cdp=&get_macro_for_CDP($char)); } } return undef; @@ -478,70 +476,63 @@ sub get_ids{ $ids=&get_char_attribute($char,"ids-aggregated") or $ids=&get_char_attribute($char,"ids"); # or $ids=&get_char_attribute($char,"ideographic-structure"); - utf8::decode($ids); # $ids=~s/[? ()]//g; return $ids; } -sub get_char_id_for_ids{ +sub get_char_for_ids{ # argument: - # return: char-id or undef. + # return: char or undef. my($ids)=@_; my($output_char); if(($output_char)=&get_chars_matching("ids",$ids)){ - utf8::decode($output_char); - return unpack("U",$output_char); + return $output_char; }else{ return undef; } } -sub get_char_id{ - # argument: , - # return: char-id. - my($char_id,$in_cs)=@_; +sub get_char_in_mcs{ + # argument: , + # return: char in ucs@mcs. + my($char,$in_cs)=@_; my($output_char); - return $char_id if($in_cs eq 'ucs@mcs'); + return $char if($in_cs eq 'ucs@mcs'); - if(($output_char)=&get_chars_matching("=$in_cs",$char_id)){ - utf8::decode($output_char); - return unpack("U",$output_char); + if(($output_char)=&get_chars_matching("=$in_cs",unpack("U",$char))){ + return $output_char; }else{ - return $char_id; + return $char; } } -sub get_char_id_unified{ - my($char_id)=@_; - my($char,$chars,$ucs); - my(@char_id); - $char=pack("U",$char_id); +sub get_chars_unified{ + my($char)=@_; + my($chars,$ucs,$char_ucs); + my(@chars); if($chars=&get_char_attribute($char,'->ucs-unified')){ - utf8::decode($chars); $chars=~s/^\((.*)\)$/$1/; - return map {unpack("U",$_)} (split(/\s*\?/,$chars)); - }elsif($ucs=&get_char_attribute(pack("U",$char_id),'=>ucs')){ - if($chars=&get_char_attribute(pack("U",$ucs),'->ucs-unified')){ - utf8::decode($chars); + return (split(/\s*\?/,$chars)); + }elsif($ucs=&get_char_attribute($char,'=>ucs')){ + $char_ucs=pack("U",$ucs); + if($chars=&get_char_attribute($char_ucs,'->ucs-unified')){ $chars=~s/^\((.*)\)$/$1/; - @char_id=grep {$char_id!=$_} - map {unpack("U",$_)} - (split(/\s*\?/,$chars)); - push(@char_id,$ucs); - return @char_id; + @chars=grep {not /^$char$/} + (split(/\s*\?/,$chars)); + push(@chars,$char_ucs); + return @chars; } } } sub get_macro_for_GT{ - # argument: + # argument: # return: TeX macro for GT fonts or undef. - my($char_id)=@_; - my($char,$gt,$GT); - $char=pack("U",$char_id); + my($char)=@_; + my($gt,$GT); foreach (@GT){ if($gt=&get_char_attribute($char,$_)){ m/gt\-pj\-(\d+)/ and $GT=$1; @@ -558,11 +549,10 @@ sub get_macro_for_GT{ } sub get_macro_for_HZK{ - # argument: + # argument: # return: TeX macro for Hanziku fonts or undef. - my($char_id)=@_; - my($char,$hzk,$HZK); - $char=pack("U",$char_id); + my($char)=@_; + my($hzk,$HZK); foreach (@HZK){ if($hzk=&get_char_attribute($char,$_)){ m/hanziku\-(\d+)/ and $HZK=$1; @@ -577,24 +567,23 @@ sub get_macro_for_HZK{ } sub get_macro_for_CDP{ - # argument: + # argument: # return: TeX macro for CDP fonts or undef. - my($char_id)=@_; - my($char,$cdp,$ucs); - $char=pack("U",$char_id); + my($char)=@_; + my($cdp,$ucs); foreach (@CDP){ if($cdp=&get_char_attribute($char,$_)){ last; } } if($cdp){ - $ucs=&get_char_attribute(utf8::decode(&get_chars_matching("=big5-pua",$cdp)),"=ucs"); + $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 "This should not happen.\n"; print STDERR "ucs code point of CDP: $cdp not found.\n"; } }else{