refine subroutine.
authorimiyazaki <imiyazaki>
Sun, 5 Oct 2003 17:13:09 +0000 (17:13 +0000)
committerimiyazaki <imiyazaki>
Sun, 5 Oct 2003 17:13:09 +0000 (17:13 +0000)
chise2otf/chise2otf

index eb100c6..1e662ec 100755 (executable)
@@ -133,7 +133,7 @@ while(<>){
            next;
        }elsif($char_id>=0x2ff0 and $char_id<=0x2fff){
            # Ideographic Description Characters
-           &ids_parse();
+           print &ids_parse();
            next;
        }elsif($char_id >= 0x20000 && $char_id <=0x2a6df){
            # CJK Unified Ideographs Extension B
@@ -173,12 +173,20 @@ print IDSDATA '$ids_start=',$ids_start,";\n";
 print IDSDATA "1;";
 
 ### to use makefonts scripts, please uncomment the next lines.
-# system($perl,$makefonts) ==0
-#    or die "Could not make fonts: $?";
+#if(-f $makefonts){
+#    system($perl,$makefonts) ==0
+#      or die "Could not make fonts: $?";
+#}else{
+#    print STDERR "cannot find $makefonts\n";
+#}
 
 exit 0;
 
 sub ids_parse{
+    # arguments: none
+    # return: 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){
@@ -186,28 +194,25 @@ sub ids_parse{
        $i++;
        if($i>$#chars){
            print STDERR "IDS parse error: $ids\n";
-           print $geta;
-           $ids="";
-           $ids_argc=0;
-           return;
+           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))){
-               print $out_char;
+               return $out_char;
            }else{
-               print &replace_ids($ids) if($perl56);
-               print encode('utf8', &replace_ids($ids)) if($perl58);
+               return &replace_ids($ids) if($perl56);
+               return encode('utf8', &replace_ids($ids)) if($perl58);
            }
-           $ids="";
-           return;
        }
     }
 }
 
 sub ids_rest{
+    # arguments: <ids>, <rest number of arguments for ids>, <character>
+    # return: ids and rest number of arguments for ids.
     my($ids,$ids_argc,$char)=@_;
     my($argc);
     $argc=&ids_argc($char);
@@ -222,6 +227,9 @@ sub ids_rest{
 }
 
 sub replace_ids{
+    # argument: <ids>
+    # return: TeX macro for ids
+    #          or GETA character if ids is invalid for KAGE.
     my($ids)=@_;
     $ids=&normalize_ids($ids,"UniJIS");
     return $geta if(($ids!~/[$idc]/)
@@ -242,9 +250,12 @@ sub replace_ids{
 }
 
 sub normalize_ids{
+    # argument: <ids>, <output coding system>
+    # 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;
+
     my $output_ids="";
     my($char,$char_id,$output_char_id);
     while($ids=~m/(.)/g){
@@ -264,45 +275,46 @@ sub normalize_ids{
 }
 
 sub get_output_char{
+    # argument: <char-id>
+    # return: character in EUC-JP or TeX macro for pTeX.
     my($char_id)=@_;
-    my($char,$out_char,$suffix);
-    my($jis,$euc,$gt);
+    my($char,$out_char,$out_char_id,$gt);
     
     $char=pack('U',$char_id);
 
-    if($jis=&get_char_attribute($char,'=jis-x0208')){
-       return pack("S",$jis|0x8080);
+    if($out_char=&get_char_attribute($char,'=jis-x0208')){
+       return pack("S",$out_char|0x8080);
     }else{
        foreach $out_cs (@order){
            if($out_cs eq 'UniJIS'
               and &get_char_attribute($char,"adobe-unijis-utf16-h")){
-               if($out_char=&get_char_attribute($char,'=ucs@jis')
-                  or $out_char=&get_char_attribute($char,'=ucs')){
-                   return "\\UTF{".sprintf("%X",$out_char)."}";
+               if($out_char_id=&get_char_attribute($char,'=ucs@jis')
+                  or $out_char_id=&get_char_attribute($char,'=ucs')){
+                   return "\\UTF{".sprintf("%X",$out_char_id)."}";
                }
            }elsif($out_cs eq 'UniGB'
                   and &get_char_attribute($char,"adobe-unigb-ucs2-h")){
-               if($out_char=&get_char_attribute($char,'=ucs@gb')
-                  or $out_char=&get_char_attribute($char,'=ucs')){
-                   return "\\UTFC{".sprintf("%X",$out_char)."}";
+               if($out_char_id=&get_char_attribute($char,'=ucs@gb')
+                  or $out_char_id=&get_char_attribute($char,'=ucs')){
+                   return "\\UTFC{".sprintf("%X",$out_char_id)."}";
                }
            }elsif($out_cs eq 'UniCNS'
                   and &get_char_attribute($char,"adobe-unicns-ucs2-h")){
-               if($out_char=&get_char_attribute($char,'=ucs@cns')
-                  or $out_char=&get_char_attribute($char,'=ucs')){
-                   return "\\UTFT{".sprintf("%X",$out_char)."}";
+               if($out_char_id=&get_char_attribute($char,'=ucs@cns')
+                  or $out_char_id=&get_char_attribute($char,'=ucs')){
+                   return "\\UTFT{".sprintf("%X",$out_char_id)."}";
                }
            }elsif($out_cs eq 'UniKS'
                   and &get_char_attribute($char,"adobe-uniks-ucs2-h")){
-               if($out_char=&get_char_attribute($char,'=ucs@ks')
-                  or $out_char=&get_char_attribute($char,'=ucs')){
-                   return "\\UTFK{".sprintf("%X",$out_char)."}";
+               if($out_char_id=&get_char_attribute($char,'=ucs@ks')
+                  or $out_char_id=&get_char_attribute($char,'=ucs')){
+                   return "\\UTFK{".sprintf("%X",$out_char_id)."}";
                }
            }elsif($out_cs eq 'GT'){
                return $gt if($gt=&get_macro_for_GT($char_id));
            }elsif($out_cs eq 'Multi'){
-               if($out_char=&get_char_attribute($char,'=ucs')){
-                   return "\\UTFM{".sprintf("%X",$out_char)."}";
+               if($out_char_id=&get_char_attribute($char,'=ucs')){
+                   return "\\UTFM{".sprintf("%X",$out_char_id)."}";
                }
            }
        }
@@ -311,6 +323,8 @@ sub get_output_char{
 }
 
 sub get_ids{
+    # argument: <character>
+    # return: ids
     my($char)=@_;
     my $ids="";
     $ids=&get_char_attribute($char,"ids-aggregated")
@@ -320,12 +334,15 @@ sub get_ids{
 }
 
 sub get_char_id_for_ids{
+    # argument: <character>
+    # return: char-id
     my($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);
        }
@@ -342,6 +359,7 @@ sub get_char_in_ucsmcs{
 
     if(&get_reverse_db("=$in_cs")){
        if($output_char=$reverse_chardb{"=$in_cs"}->{$char}){
+           $output_char=decode('utf8',$output_char) if($perl58);
            return $output_char=~s/^\?//;
        }
     }else{
@@ -350,6 +368,8 @@ sub get_char_in_ucsmcs{
 }
 
 sub get_macro_for_GT{
+    # argument: <char-id>
+    # return: TeX macro for GT fonts.
     my($char_id)=@_;
     my($char,$gt,$GT);
     $char=pack("U",$char_id);