#
# Copyright 1998 VMware, Inc.  All rights reserved. -- VMware Confidential
#

use FileHandle;
package VMware::Control::Keycode;

use strict;

use vars qw($VERSION);

$VERSION = '1.01';

# XXX these are bogus -- they only work for us101
# Map shifted punc marks to unshifted keys
my %shifted_punctuation = (
    "!" => "1",
    "@" => "2",
    "#" => "3",
    '$' => "4",
    '%' => "5",
    '^' => "6",
    '&' => "7",
    '*' => "8",
    "(" => "9",
    ")" => "0",
    "<" => "comma",
    ">" => "period",
    "?" => "slash",
    "\"" => "apostrophe",
    ":" => "semicolon",
    "_" => "minus",
    "+" => "equal",
    "{" => "bracketleft",
    "}" => "bracketright",
    "|" => "backslash",
    "~" => "grave"
    );

# Map punc marks to key identifiers
my %punctuation = (
    "," => "comma",
    "." => "period",
    "/" => "slash",
    "'" => "apostrophe",
    ";" => "semicolon",
    " " => "space",
    "-" => "minus",
    "=" => "equal",
    "[" => "bracketleft",
    "[" => "bracketright",
    "\\" => "backslash",
    "`" => "grave",
    "\n" => "Return"
    );


sub new($$) {
    my $proto = shift;
    my $filename = shift;
    my $class = ref($proto) || $proto;
    my $self = {};

    my $fh = new FileHandle;

    if (!open($fh, "<$filename")) {
        return undef;
    }

    my %scancode_to_key;
    my %key_to_scancode;

    while(<$fh>) {
        # Perl 5.005 doesn't support [:xdigit:] :(
        if (m/^\s*(\S+)\s*=\s*([x\dabcdefABCDEF]+)/) {
            my ($key, $scancode) = ($1, $2);

            if ($scancode =~ m/^0x[\dabcdefABCDEF]+$/) {
                $scancode = hex($scancode);
            }
             
            $key_to_scancode{$key} = $scancode;
            $scancode_to_key{$scancode} = $key;
        }
    }

    close($fh);

    if (scalar(keys(%key_to_scancode)) != scalar(keys(%scancode_to_key))) {
        #print STDERR "Warning: duplicate keys or scancodes in $filename\n";
    }

    $self->{fh} = $fh;
    $self->{key_to_scancode} = \%key_to_scancode;
    bless($self, $class);

    return $self;
}

sub keystroke_to_scancode {
    my $k = shift;
    my $key = shift;
    my %key_to_scancode = %{$k->{key_to_scancode}};

    if (defined($key_to_scancode{$key})) {
        return $key_to_scancode{$key};
    }

    if (defined($punctuation{$key}) && defined($key_to_scancode{$punctuation{$key}})) {
        return $key_to_scancode{$punctuation{$key}};
    }

    return undef;
}

# Return the unshifted key glyph followed by a list of modifier keys
#  (Shift, Alt, Meta, etc.)
sub unshift_key {
    my $k = shift;
    my $key = shift;
    my %key_to_scancode = %{$k->{key_to_scancode}};
    my @modifiers = ();

    if (lc($key) ne $key) {
        push(@modifiers, "Shift_L");
        unshift(@modifiers, lc($key));
    } elsif (defined($shifted_punctuation{$key})) {
        push(@modifiers, "Shift_L");
        unshift(@modifiers, $shifted_punctuation{$key});
    } else {
        return undef;
    }

    return wantarray ? @modifiers : $modifiers[0];
}

1;

__END__

=head1 NAME

VMware::Control::Keycode - A perl module for manipulating scancode/ASCII translation

=head1 SYNOPSIS

=head1 DESCRIPTION

TBD

=head1 AUTHORS

Brett Vasconcellos

=head1 COPYRIGHT

    (c) 2000-2001 VMware Incorporated.  All rights reserved.

=head1 VERSION

=head1 SEE ALSO

perl(1).

=cut
