#!/usr/bin/perl
# -*- coding: shift_jis -*-
# bellda layout : a Japanese keyboard layout like 'pocket bell' input method
# Time-stamp: <Jun 03 2008>

# original script: http://www.massangeana.com/mas/charsets/hana/hanasetup.htm
# this script: http://ai11.net/2008/05/12/
# requirement: (Windows) ActivePerl
# Usage: [Windows CommandPrompt]> c:\Perl\bin\perl.exe bellda-atok.pl < ATOK21.STY > BELLDA21.STY
# Usage: [Solaris Terminal]$ perl bellda-atok.pl -u < /usr/share/iiim/le/atokx2/original/atok17.sty > ~/.iiim/le/atokx2/users/USRNAME/bellda17.sty

$romakana =
'ww=ｱ|we=ｲ|wr=ｳ|ws=ｴ|wd=ｵ|ew=ｶ|ee=ｷ|er=ｸ|es=ｹ|ed=ｺ|rw=ｻ|'.
're=ｼ|rr=ｽ|rs=ｾ|rd=ｿ|sw=ﾀ|se=ﾁ|sr=ﾂ|ss=ﾃ|sd=ﾄ|dw=ﾅ|de=ﾆ|'.
'dr=ﾇ|ds=ﾈ|dd=ﾉ|fw=ﾊ|fe=ﾋ|fr=ﾌ|fs=ﾍ|fd=ﾎ|xw=ﾏ|xe=ﾐ|xr=ﾑ|'.
'xs=ﾒ|xd=ﾓ|cw=ﾔ|ce=､|cr=ﾕ|cs=｡|cd=ﾖ|vw=ﾗ|ve=ﾘ|vr=ﾙ|vs=ﾚ|'.
'vd=ﾛ|gw=ﾜ|ge=ｦ|gr=ﾝ|gs=ﾞ|gd=ﾟ|aw=ｬ|ae=｢|ar=ｭ|as=｣|ad=ｮ|'.
'af=ｯ|qw=ｧ|qe=ｨ|qr=ｩ|qs=ｪ|qd=ｫ|fv=ｰ|z=ﾞ|t=ﾟ|wu=ｱ|wi=ｲ|wo=ｳ|'.
'wj=ｴ|wk=ｵ|eu=ｶ|ei=ｷ|eo=ｸ|ej=ｹ|ek=ｺ|ru=ｻ|ri=ｼ|ro=ｽ|rj=ｾ|'.
'rk=ｿ|su=ﾀ|si=ﾁ|so=ﾂ|sj=ﾃ|sk=ﾄ|du=ﾅ|di=ﾆ|do=ﾇ|dj=ﾈ|dk=ﾉ|'.
'fu=ﾊ|fi=ﾋ|fo=ﾌ|fj=ﾍ|fk=ﾎ|xu=ﾏ|xi=ﾐ|xo=ﾑ|xj=ﾒ|xk=ﾓ|cu=ﾔ|'.
'ci=､|co=ﾕ|cj=｡|ck=ﾖ|vu=ﾗ|vi=ﾘ|vo=ﾙ|vj=ﾚ|vk=ﾛ|gu=ﾜ|gi=ｦ|'.
'go=ﾝ|gj=ﾞ|gk=ﾟ|au=ｬ|ai=｢|ao=ｭ|aj=｣|ak=ｮ|al=ｯ|qu=ｧ|qi=ｨ|'.
'qo=ｩ|qj=ｪ|qk=ｫ|f.=ｰ|n=ﾞ|p=ﾟ|uu=ｱ|ui=ｲ|uo=ｳ|uj=ｴ|uk=ｵ|iu=ｶ|'.
'ii=ｷ|io=ｸ|ij=ｹ|ik=ｺ|ou=ｻ|oi=ｼ|oo=ｽ|oj=ｾ|ok=ｿ|ju=ﾀ|ji=ﾁ|'.
'jo=ﾂ|jj=ﾃ|jk=ﾄ|ku=ﾅ|ki=ﾆ|ko=ﾇ|kj=ﾈ|kk=ﾉ|lu=ﾊ|li=ﾋ|lo=ﾌ|'.
'lj=ﾍ|lk=ﾎ|mu=ﾏ|mi=ﾐ|mo=ﾑ|mj=ﾒ|mk=ﾓ|,u=ﾔ|,i=､|,o=ﾕ|,j=｡|'.
',k=ﾖ|.u=ﾗ|.i=ﾘ|.o=ﾙ|.j=ﾚ|.k=ﾛ|;u=ﾜ|;i=ｦ|;o=ﾝ|;j=ﾞ|;k=ﾟ|'.
'hu=ｬ|hi=｢|ho=ｭ|hj=｣|hk=ｮ|hl=ｯ|yu=ｧ|yi=ｨ|yo=ｩ|yj=ｪ|yk=ｫ|'.
'l.=ｰ|uw=ｱ|ue=ｲ|ur=ｳ|us=ｴ|ud=ｵ|iw=ｶ|ie=ｷ|ir=ｸ|is=ｹ|id=ｺ|'.
'ow=ｻ|oe=ｼ|or=ｽ|os=ｾ|od=ｿ|jw=ﾀ|je=ﾁ|jr=ﾂ|js=ﾃ|jd=ﾄ|kw=ﾅ|'.
'ke=ﾆ|kr=ﾇ|ks=ﾈ|kd=ﾉ|lw=ﾊ|le=ﾋ|lr=ﾌ|ls=ﾍ|ld=ﾎ|mw=ﾏ|me=ﾐ|'.
'mr=ﾑ|ms=ﾒ|md=ﾓ|,w=ﾔ|,e=､|,r=ﾕ|,s=｡|,d=ﾖ|.w=ﾗ|.e=ﾘ|.r=ﾙ|'.
'.s=ﾚ|.d=ﾛ|;w=ﾜ|;e=ｦ|;r=ﾝ|;s=ﾞ|;d=ﾟ|hw=ｬ|he=｢|hr=ｭ|hs=｣|'.
'hd=ｮ|hf=ｯ|yw=ｧ|ye=ｨ|yr=ｩ|ys=ｪ|yd=ｫ|lv=ｰ|';

@romakana_table = sort(split('\\|', $romakana));

my $charcode="shift_jis";
if ($ARGV[0] =~ /\-+u(tf8)?/){
    $charcode = "utf-8";
}

while (<STDIN>) {
    next if (/^[ \t]*\;/);
    # ".*" is a dirty trick to make RE work on plain Perl.
    # 8文字飛ばしてそのあとの8文字が $1 に

    # WindowsのATOK2006,2007,2008は Shift_JIS
    if ($charcode eq "shift_jis" and /^ロ.*マ字=........(........)/) { 
        $_ = 'ローマ字=' . &convert($1) . "\n";
    }
    # ATOK for Solaris (ATOK17 for Solaris10)は UTF-8
    if ($charcode eq "utf-8" and /^\xe3\x83\xad\xe3\x83\xbc\xe3\x83\x9e\xe5\xad\x97=........(........)/) { 
        $_ = "\xe3\x83\xad\xe3\x83\xbc\xe3\x83\x9e\xe5\xad\x97=" . &convert($1) . "\n";
    }

    print;
}

sub nhex {
    # value , width
    local ($val, $wid) = @_;
    sprintf("%0${wid}x", $val);
}

sub convert {
    # $rが求めている文字列。
    # まず 「ローマ字=対応日本語」の要素数+1を、%08x で出力。そのあと8文字はもともとのを出力。
    local ($r) = &nhex($#romakana_table + 1, 8) . $_[0];
    local ($i, $c, $sum, $nroma, $nkana);
    # ローマ字の最初の1文字の出てくる頻度を探る。
    for (@romakana_table) {
        /^(.)/;
        $FREQ{$1}++;
    }
    $sum = 0;
    for ($i = 0x20; $i <= 0x7f; $i++) {
        # pack'C'→unsigned char。 $iが0x61のときは $c は 'a' になる。
        $c = pack('C', $i);
        # 16進数4文字で計、16進数4文字で 0x20〜0x7fの各文字の頻度
        $r .= &nhex($sum, 4) . &nhex($FREQ{$c}, 4);
        $sum += $FREQ{$c};
    }
    $sum = 0;
    for (@romakana_table) {
        /^(.+)\=(.+)$/;
        # nkanaの数値は1以外があるのか…？
        $nroma = length($1);
        $nkana = length($2);
        # 16進数4文字で計、16進数2文字でローマ字1要素の長さ、16進数2文字でかな1文字ぶんの長さ
        $r .= &nhex($sum, 4) . &nhex($nroma, 2) . &nhex($nkana, 2);
        $sum += $nroma + $nkana;
    }
    for (@romakana_table) {
        /^(.+)\=(.+)$/;
        for $i (unpack('C*', $1)) {
            # unpack('C*') で、'a'が [97(0x61)]、"abc"が [97,98,99] になる。配列で返すので注意。
            # 16進数4文字でローマ字1要素の1文字ずつ ('ww' だったら 'w' 'w'の2ループ)
            $r .= &nhex($i, 4);
        }
        for $i (unpack('C*', $2)) {
            # 'ｱ' (ShiftJIS 0xb1)なら、UCS2 Halfwidth Katakana の 0xff71 になる。
            $r .= &nhex($i - 0xa0 + 0xff60, 4); # convert to UCS
        }
    }
    $r;
}