add "kage" option.
authorimiyazaki <imiyazaki>
Mon, 6 Oct 2003 14:39:54 +0000 (14:39 +0000)
committerimiyazaki <imiyazaki>
Mon, 6 Oct 2003 14:39:54 +0000 (14:39 +0000)
refine

chise2otf/chise2otf

index 6351d7f..0b8207d 100755 (executable)
@@ -1,7 +1,7 @@
 #!/usr/bin/perl
 
 use strict;
-use vars qw($opt_in_cs $opt_order $opt_help $usage
+use vars qw($opt_in_cs $opt_order $opt_kage $opt_help $usage
            $in_cs $out_cs $i @chars
            @order $order %order
            $char $char_id $out_char
@@ -16,6 +16,7 @@ use Chise_utils ':all';
 
 my $perl="/usr/bin/perl";
 my $makefonts="/Users/izumi/.chise/makefonts.pl";
+my $exec_makefonts=0;
 my $geta=pack("S",8750|0x8080);
 
 if($^V and $^V ge v5.8){
@@ -32,14 +33,12 @@ if($perl58){
 }
 
 &GetOptions("in=s"=>\$opt_in_cs,
-           "i=s"=>\$opt_in_cs,
-           "o=s"=>\$opt_order,
            "order=s"=>\$opt_order,
-           "help",\$opt_help,
-           "h",\$opt_help);
+           "kage",\$opt_kage,
+           "help",\$opt_help);
 
 $usage=<<EOF;
-Usage: $0 -i <input coding system> -o <order of kanji> <filename>
+Usage: $0 [-i <input coding system>] [-o <order of kanji>] [-k] <filename>
     input coding system: (default: ucs\@mcs)
       ucs\@mcs, ucs\@cns, ucs\@gb, ucs\@jis, ucs\@ks
     order of kanji: (default: j)
@@ -50,6 +49,7 @@ Usage: $0 -i <input coding system> -o <order of kanji> <filename>
        t: GT
        m: Multi, use \\UTFM of otf.sty
       You can also combine them, ex. jtcgkm
+    k: use Kage server.
 EOF
 
 %order=('c'=>'UniCNS',
@@ -98,6 +98,10 @@ if(defined($opt_order)){
     }
 }
 
+if($opt_kage){
+    $exec_makefonts=1;
+}
+
 $idsdata_file="idsdata.pl";
 $ids_start=0x00; 
 $font_start=0;
@@ -122,7 +126,9 @@ $ids="";
 
 while(<>){
     s/&(.*?);/&de_er($1)/ge;
-    s/(.)/&get_char_in_ucsmcs($1,$in_cs)/ge if($in_cs ne 'ucs@mcs');
+    if($in_cs ne 'ucs@mcs'){
+       s/(.)/pack("U",&get_char_id(unpack("U",$1),$in_cs))/ge;
+    }
     @chars=split(//);
     for($i=0;$i<=$#chars;$i++){
        $char=$chars[$i];
@@ -155,7 +161,7 @@ while(<>){
            if(($out_char=&get_output_char($char_id))){
                print $out_char;
            }else{
-               print &replace_ids(&get_ids($char));
+               print &get_macro_for_ids(&get_ids($char));
            }
        }
     }
@@ -173,13 +179,14 @@ print IDSDATA '$font_start=',$font_start,";\n";
 print IDSDATA '$ids_start=',$ids_start,";\n";
 print IDSDATA "1;";
 
-### to use makefonts scripts, please uncomment the next lines.
-#if(-f $makefonts){
-#    system($perl,$makefonts) ==0
-#      or die "Could not make fonts: $?";
-#}else{
-#    print STDERR "cannot find $makefonts\n";
-#}
+if($exec_makefonts){
+    if(-f $makefonts){
+       system($perl,$makefonts) ==0
+           or die "Could not make fonts: $?";
+    }else{
+       print STDERR "cannot find $makefonts\n";
+    }
+}
 
 exit 0;
 
@@ -204,8 +211,8 @@ sub ids_parse{
               and($out_char=&get_output_char($char_id))){
                return $out_char;
            }else{
-               return &replace_ids($ids) if($perl56);
-               return encode('utf8', &replace_ids($ids)) if($perl58);
+               return &get_macro_for_ids($ids) if($perl56);
+               return encode('utf8', &get_macro_for_ids($ids)) if($perl58);
            }
        }
     }
@@ -227,11 +234,12 @@ sub ids_rest{
     return ($ids,$ids_argc);
 }
 
-sub replace_ids{
+sub get_macro_for_ids{
     # argument: <ids>
     # return: TeX macro for ids
     #          or GETA character if ids is invalid for KAGE.
     my($ids)=@_;
+#    return $geta if(not $exec_makefonts);
     $ids=&normalize_ids($ids,"UniJIS");
     return $geta if(($ids!~/[$idc]/)
                    or($ids=~/[\x{10000}-]/));
@@ -341,33 +349,23 @@ sub get_char_id_for_ids{
     my($output_char);
     $ids=decode('utf8', $ids) if($perl58);
 
-    if(&get_reverse_db("ids")){
-       if($output_char=$reverse_chardb{"ids"}->{$ids}){
-           $output_char=decode('utf8',$output_char) if($perl58);
-           $output_char=~s/^\?//;
-           return unpack("U",$output_char);
-       }
+    if(($output_char)=&get_chars_matching("ids",$ids)){
+       return unpack("U",$output_char);
     }else{
        return undef;
     }
 }
 
-sub get_char_in_ucsmcs{
-    # argument: <character>, <input coding system>
-    # return:   character in ucs@mcs.
-    my($char,$in_cs)=@_;
+sub get_char_id{
+    # argument: <char-id>, <input coding system>
+    # return:   char-id.
+    my($char_id,$in_cs)=@_;
     my($output_char);
 
-    if(&get_reverse_db("=$in_cs")){
-       if($output_char=$reverse_chardb{"=$in_cs"}->{unpack("U",$char)}){
-           $output_char=decode('utf8',$output_char) if($perl58);
-           $output_char=~s/^\?//;
-           return $output_char;
-       }else{
-           return $char;
-       }
+    if(($output_char)=&get_chars_matching("=$in_cs",$char_id)){
+       return unpack("U",$output_char);
     }else{
-       return $char;
+       return $char_id;
     }
 }