#!/usr/bin/perl -CSD
use IO::File;
use Getopt::Std;

getopts('d:f:s:t:');

unless ($ARGV[0])
{
    die <<'EOT';
    msklc2xml [-f fontname] [-s size] infile.klc > outfile.xml
Convert MSKLC keyboard file into an XML file for merging with a keyboard layout
EOT
}

%keymap = (
    'OEM_MINUS' => '-',
    'OEM_PLUS' => '=',
    'OEM_COMMA' => ',',
    'OEM_PERIOD' => '.',
    'OEM_1' => ';',
    'OEM_2' => '/',
    'OEM_3' => '`',
    'OEM_4' => '[',
    'OEM_5' => "\\",
    'OEM_6' => ']',
    'OEM_7' => "'",
    'OEM_102' => '',
    'DECIMAL' => '',
);

%entities = (
	'>' => '&lt;',
	'&' => '&amp;',
	'>' => '&gt;',
	'"' => '&quot;',
	"'" => '&apos;'
);

$entities = join('', keys %entities);

$ifh = IO::File->new($ARGV[0], "< :encoding(UTF-16):crlf") || die "Can't open $ARGV[0]";

while (<$ifh>)
{
    chomp;
    if (m/^(DEADKEY|SHIFTSTATE|LAYOUT|KEYNAME|LIGATURE)/o)
    { 
        $mode = lc($1);
        init_mode($mode, $');       #'
    }
    elsif (m/^\/\//o || m/^\s*$/o)
    { }
    elsif ($mode)
    { &{$mode}($_); }
}

print "<?xml version='1.0' encoding='UTF-8'?>\n";
print "<keyboard font='$opt_f' size='$opt_s'>\n";

if ($opt_d)
{ $list = $deadkeys{$opt_d}; }
else
{ $list = \%keys; }

foreach $k (sort keys %{$list})
{
    my ($id) = defined $keymap{$k} ? $keymap{$k} : $k;
    my ($unshift) = as_str($list->{$k}[$basckstate[0]]);
    my ($shift) = as_str($list->{$k}[$backstate[1]]);
    next if ($id eq '');

    printf "    <key id=\"%s\" unshift='%s' shift='%s'/>\n", $id, protect($unshift), protect($shift);
}

print "</keyboard>\n";

$ifh->close;

sub protect
{
	my ($s) = @_;

	$s =~ s/([$entities])/$entities{$1}/oge;
	$s;
}

sub init_mode
{
    my ($mode, $str) = @_;

    if ($mode eq 'deadkey')
    {
        $str =~ s/^\s*//o;
        foreach $k (keys %keys)
        {
            if ($keys{$k}[$backstate[$opt_t]] eq "${str}@")
            {
                $currdead = $keymap{$k} || $k;
                last;
            }
        }
    }
}
           

sub shiftstate
{
    my ($str) = @_;

    $str =~ m/^(\d+)/o;
    push (@states, $1);
    $backstate[$1] = (@states-1);
}

sub layout
{
    my ($str) = @_;
    my (@info) = split(' ', $str);

    $keys{$info[1]} = [@info[3..@states+2]];
}

sub deadkey
{
    my ($str) = @_;
    my (@chars) = split(' ', $str);

key:
    foreach $k (keys %keys)
    {
        foreach $s (0..1)
        {
            if ($keys{$k}[$backstate[$s]] eq $chars[0])
            {
                $deadkeys{$currdead}{$k}[$s] = $chars[1];
                last key;
            }
        }
    }
}


sub keyname
{ }

sub ligature
{
    my ($str) = @_;
    $str =~ s{\s*//.*$}{}o;
    my (@chars) = split(' ', $str);
    $keys{$chars[0]}[$chars[1]] = join(' ', @chars[2..$#chars]);
}

sub as_str
{
    my ($str) = @_;
    my (@chars) = ($str =~ m/([0-9A-Fa-f]{4}|-1|.)\s*/og);

    foreach $c (@chars)
    {
        if (length($c) > 2)
        { $c = pack('U*', hex($c)); }
        elsif ($c eq '@')
        { $c = ''; }
        elsif ($c eq '-1')
        { $c = ''; }
    }
    return join('', @chars);
}

