X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fomega.git;a=blobdiff_plain;f=inCHISE;h=dd9dc47959f73d549415fa47809a859a73a49739;hp=2aeb780f8ef57465efea9dfebc28138e9a53cc99;hb=138a3a251d5d3cebfd8e201d163805150444d0f6;hpb=74c76de92eb4a85cf65bff8e8047a40e2d6522e0 diff --git a/inCHISE b/inCHISE index 2aeb780..dd9dc47 100755 --- a/inCHISE +++ b/inCHISE @@ -1,17 +1,18 @@ -#!/usr/bin/perl -CSD +#!/usr/bin/perl -w -CSD # ver.0.2 use strict; use vars qw($omegadb_path $opt_protrude $opt_allow_unify + $opt_use_kage_for_Ext_B %opt_order %order %order_map $opt_in_cs $opt_out_cs $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 ); @@ -21,20 +22,21 @@ use Fcntl ':flock'; use Chise_utils ':all'; require 5.008; -my $omegadb_path="/usr/local/lib/chise/omega"; - ### Options ### #$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'; -$opt_allow_unify=0; # 1=true, 0=false. +$opt_allow_unify=1; # 1=true, 0=false. $opt_protrude=0;# 1=true, 0=false. +# currently does not work. +$opt_use_kage_for_Ext_B=0;# 1=true, 0=false. + ### End ### my $strictly_forbidden_after = '「【『[(〈“‘‘(〔{《{\[\(\x{3016}{「'; @@ -58,10 +60,22 @@ 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}'; +my %tex_meta=('#'=>'\#', + '$'=>'\\textdollar{}', + '%'=>'\%', + '&'=>'\&', + '{'=>'\\textbraceleft{}', + '}'=>'\\textbraceright{}', + '\\'=>'\\textbackslash{}', + '_'=>'\\textunderscore', + ); + +my $tex_meta_re=join('|',map {quotemeta($_)} keys %tex_meta); + &GetOptions("in=s"=>\$opt_in_cs, "out=s"=>\$opt_out_cs, "help",\$opt_help); @@ -119,6 +133,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 +156,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 +171,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; @@ -167,6 +184,9 @@ while(<>){ if($char_id<=0x20){ print $chars[$i]; next CHAR; + }elsif($char=~m/($tex_meta_re)/o){ + print $tex_meta{$1}; + next CHAR; }elsif($char_id>0x20 and $char_id<=0x02af){ # Basic Latin # Latin-1 Supplement @@ -180,36 +200,39 @@ 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 - if(not defined($ids{$char}) and $ids{$char}[1]>=0){ - $ids{$char}[0]=$font_start; - $ids{$char}[1]=$ids_start; - $ids_start++; - if($ids_start>255){ - $ids_start=0; - $font_start++; - } - } - print "{\\fontencoding{OT1}\\fontfamily{" . - sprintf("chise%03d",$ids{$char}[0]) . - "}\\selectfont\\char$ids{$char}[1]}",&add_break($i); - 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; } } } } + if($opt_use_kage_for_Ext_B){ + if($char_id >= 0x20000 && $char_id <=0x2a6df){ + # 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++; + if($ids_start>255){ + $ids_start=0; + $font_start++; + } + } + print "{\\fontencoding{OT1}\\fontfamily{" . + sprintf("chise%03d",$ids{$char}[0]) . + "}\\selectfont\\char$ids{$char}[1]}",&add_break($i); + next CHAR; + } + } if($ids=&get_ids($char)){ print &get_macro_for_ids($ids),&add_break($i); }else{ @@ -247,7 +270,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; @@ -316,7 +338,7 @@ sub latin_parse{ } $i++; } - return '{\normalfont {'.$out_str.'}}'; + return '{\fontencoding{UT1}\fontfamily{omlgc}\selectfont '.$out_str.'}'; } sub ids_parse{ @@ -331,18 +353,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 +375,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); } @@ -369,12 +388,11 @@ sub get_macro_for_ids{ # 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",0x3013) if(($ids!~/[$idc]/) - or($ids=~/[\x{10000}-]/)); + # $ids=&normalize_ids($ids,"UniJIS"); + return $geta if(($ids!~/[$idc]/) + or($ids=~/[\x{10000}-]/)); #irregular for KAGE. - if(not defined($ids{$ids}) and $ids{$ids}[1]>=0){ + if(not defined($ids{$ids})){ $ids{$ids}[0]=$font_start; $ids{$ids}[1]=$ids_start; $ids_start++; @@ -395,33 +413,32 @@ 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")){ + }elsif($output_char_id=&get_char_attribute($char,"=$out_cs") + or $output_char_id=&get_char_attribute($char,"=ucs") + or $output_char_id=&get_char_attribute($char,"=>$out_cs") + or $output_char_id=&get_char_attribute($char,"=>ucs") + or $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")){ @@ -429,6 +446,7 @@ sub get_output_char{ 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') + or $out_char_id=&get_char_attribute($char,'=>ucs*') ){ return '{\selectjisfont\char'.$out_char_id.'}'; } @@ -438,6 +456,7 @@ sub get_output_char{ 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') + or $out_char_id=&get_char_attribute($char,'=>ucs*') ){ return '{\selectgbsfont\char'.$out_char_id.'}'; } @@ -447,6 +466,7 @@ sub get_output_char{ 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') + or $out_char_id=&get_char_attribute($char,'=>ucs*') ){ return '{\selectcnsfont\char'.$out_char_id.'}'; } @@ -456,15 +476,16 @@ sub get_output_char{ 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') + 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)); + 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; @@ -475,73 +496,69 @@ sub get_ids{ # return: ids my($char)=@_; my $ids=""; - $ids=&get_char_attribute($char,"ids-aggregated") +# $ids=&get_char_attribute($char,"ids-aggregated") +# or $ids=&get_char_attribute($char,"ids"); + $ids=&get_char_attribute($char,"ids-decomposed") 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*') + or $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 +575,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 +593,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{