#!/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
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){
}
&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)
t: GT
m: Multi, use \\UTFM of otf.sty
You can also combine them, ex. jtcgkm
+ k: use Kage server.
EOF
%order=('c'=>'UniCNS',
}
}
+if($opt_kage){
+ $exec_makefonts=1;
+}
+
$idsdata_file="idsdata.pl";
$ids_start=0x00;
$font_start=0;
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];
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));
}
}
}
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;
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);
}
}
}
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}-]/));
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;
}
}