#!/usr/bin/perl -w
# Dump a Maemo keyboard file (hildon-input-method-plugins-western package).
# Keyboard files are in /usr/share/keyboards ; typical basename is en_US.vkb

# This program can read all the national keyboards in /usr/share/keyboards,
# including latin.special.vkb.

# Source for the package is not available, so the file format is reverse
# engineered.
#   \1 \2 (magic number); 2nd number may be number of keyboard sets.
#   String: text name of writing system: "English (USA)"
#	These strings contain UTF-8.  First byte is a length in octets (not
#	UTF-8 characters).  No ending \0.
#   String: Locale code "en_US"
#   String: Locale code "en_US" (in the ones I looked at, they're the same)
#   4 bytes, the last of which is the repetition of the following items.
#   N repeats of 5 bytes, possibly dimensions; last 2 bytes always 0.
#   1 byte in latin.special.vkb, 3 bytes in national keyboards.
#   21 bytes of 0.
#   1 or 2 KeyboardSets: national keyboards have a set of 2 (unshift, shift) 
#	for the regular input method followed by a set of 4 for the thumb
#	input method.  the set begins 0 N 0 0; N = number of keyboards.  
#	A Keyboard begins 0 1, 
#	    Then a Unicode string with its label (empty in the regular method)
#	    Then 1 or 2 panels (alpha and numeric), if the KeyboardSet's 1st
#		byte is 0 then 2 panels, 4 -> 1 panel.
#	    Panel begins with 6 non-obvious bytes; the 2nd is the number of
#		keys in the panel, except on numeric panels the 1st byte
#		is the number of keys.
#	    4 bytes of row sizes
#	    Then the rows which are lists of units each in this format:
#		f0 = normally 0, or 1 for alternate format.
#		f1 = character types.  1 = alphabetic; 2 = decimal digit; 
#		    4 = hex digit; 8 = some punct + digits + W and P; 
#		    16 = all punctuation, 32 = overprinting accent
#		Unicode string for the letter (length in octets, then char.)
#		    Alternate format: number of Unicode strings + 0x80, 
#		    followed by that many strings (12 in the only examples).
#		f4 = 1 for a 1.5x size key at the left end, 2 at right, 
#		    normally 0, always 3 on thumb keyboard.
#   No extraneous stuff at the end of the file.

# Keyboard geometry: left to right, control column, main keyboard, numeric
# area, another control column.  The control columns probably can't be changed.
# The main keyboard has these rows:	Numeric keyboard: (en_US layout)
#   qwertyioup@		11 slots	123	3 slots
#   asdfghjkl;'!	12 slots	456	3 slots
#   zxcvbnm,./?		11 slots	789	3 slots
#   word completion and space bar	+0=	3 slots

use strict;
use IO::File;

binmode(STDOUT, ":encoding(UTF-8)");

# Object for the input file.  It's a hash with these keys:
#   FD		FileHandle of the file
#   name	Filename
#   adr		Offset in the file where an object started reading.
#   end		Offset at the end of the object.
package MyFile;

# Argument: file to read.  call as MyFile->new($filename)
sub new {	# MyFile
    my($pkg, $fname) = @_;
    my $this = bless( {
	FD	=> IO::File->new($fname, "<"),	# "<:utf8"
	name	=> $fname,
	adr	=> 0,
	end	=> 0,
	}, $pkg);
    die "Can't read input file '$fname': $!\n" unless defined($this->{FD});
    $this;
}

# Reads N bytes from the file.  Args:
#   $this	MyFile object
#   $N		Number of bytes wanted.  Special cases: if $N is <= 0, up to
#		4096 bytes are read (should read to EOF).
#   Returns	The bytes read as a string; undef on EOF; dies on any 
#		other error.  
sub readn {	# MyFile
    my($this, $N) = @_;
    $this->{adr} = $this->{end};
    my $M = ($N <= 0) ? 4096 : $N;	# Number of bytes wanted in buffer
    my $bfr = "";
    my $rc = read($this->{FD}, $bfr, $M);
    if (!defined($rc)) {
	die "Error reading '${$this}{name}': $!\n";
    } elsif ($rc == 0) {
	return undef;			# End of file
    } elsif ($rc != $M && !(defined($N) && $N > 0)) {
	die "Error on '${$this}{name}', short read, wanted $M chars, got $rc chars.\n";
    }
    $this->{end} += $M;
    return $bfr;
}

# Reads N bytes and returns the result as an integer.  $1 is a pack code
# (1 byte allowed, only integral types) telling how to interpret the data.  
# Returns undef at end of file; dies on any other error.  Special case,
# a pack code of 'A' gets one UTF-8 char, returning it as a string.
our(%readpack, @uni); BEGIN {
	# $readpack{$code} = number of bytes for that code.  "A" is special.
    %readpack = qw(a 1 A 1 c 1 C 1 s 2 S 2 n 2 v 2 l 4 L 4 N 4 V 4 q 8 Q 8);
	# If the initial octet of a UTF-8 char is < $uni[$j] then 
	# the char has $j+1 octets counting the initial one.  In reality
	# only up to 4 octets are assigned and only up to 6 are "legal" in
	# UTF-8.  The range 0x80 .. 0xc1 is illegal, and is safely disposed
	# of as a single byte.
    @uni = (0xc2, 0xe0, 0xf0, 0xf8, 0xfc, 0x100);
}
sub readpack {	# MyFile
    my($this, $pack) = @_;
    my $len = $readpack{$pack};
    die "Unknown pack code '$pack'\n" unless defined($len);
    $this->{adr} = $this->{end};
    my $rc = $this->readn($len);
		# If it's a UTF-8 string and type == A, read additional bytes
		# and convert to actual Unicode.
    my $nuni = 0;			# Number of additional bytes
    if (!defined($rc)) {
	# Leave undefined value alone
    } elsif ($pack eq 'A') {
		# The number of additional octets in a Unicode char, if any.
	foreach my $u (@uni) {
	    last if ord($rc) < $u;
	    $nuni++;
	}
	if ($nuni > 0) {
	    my $rc2 = $this->readn($nuni);
	    return undef unless defined($rc2);
	    $rc .= $rc2;
	    my $uni = unpack('U', $rc);	# Gives a Unicode code point number
	    $rc = pack('U', $uni);	# Converts to a UTF-8 string
#	    printf  "readpack returns unicode '%s' (%s %d)\n", $rc, $pack, $len; #DEBUG
	}
		# If a UTF-8 char was read, advance the file byte count to 
		# account for the actual number of octets so dump addresses 
		# will come out right.
		# This section is now unwanted because the file is not UTF-8.
#	my $b = ord($rc);
#	$this->{end} += ($b < 0x80) ? 0 : ($b < 0x800) ? 1 : 
#	    ($b < 0x10000) ? 2 : 3;
    } else {
		# Convert bytes to integers (not if characters are wanted)
	$rc = unpack($pack, $rc);
    }
    $rc;
}

# =====
# Generic object with basic policies.  It's a hash with these keys:
#   adr		Offset in the file where the object starts
#   end		Offset in the file where the object ends
#   complete	True if the object was stuffed without error
#   parent	Ref. to the parent object
#   Plus, of course, the actual content.

# Each package that wants to inherit read() or print() needs a package global
# array called @MEMBERS containing in the order of printing and reading (same)
# a sequence of hashes with these members:
#		key	Name of the respective data member of the host object.
#		type	The type (class name) of the object, as a text string.
#		iargs	Additional arguments to sub new() after $FD.
#		glonch	Subroutine for dynamic content size (not always present)
#		oargs	Additional arguments to the print routine.  The first
#			is the object's title.

package Generic;

# Creates a new Generic object.  Args:
#   $class	Name of actual class to be created
#   $parent	Ref. to the parent object, or undef at toplevel.
#   $FD		MyFile ref to read content from.  If undef, the object is not
#		stuffed (stuff it later with $this->read($FD)).
#   @etc	Any additional arguments are passed on to read().
#   Returns:	Ref. to the new object.  Dies on any error other than EOF.
sub new {		# Generic
    my($class, $parent) = splice(@_, 0, 2);
    my $this = bless( { parent => $parent, complete => 0, }, $class);
    if (@_) {
	$this->read(@_);
    }
    $this;
}

# Stuffs a Generic object according to the members hash.  Args: class object
# reference, MyFile object to read from.  Returns true if reading succeeded,
# false (undef) on EOF, dies on any other error.
sub read {		# Generic
    my($this, $FD) = @_;
    my $res = 1;			# Assume reading will succeed.
    $this->{adr} = $FD->{end};
    my $mbrs; {no strict; $mbrs = \@{ref($this) . "::MEMBERS"}; }
    foreach my $mbr (@$mbrs) {
	my($key, $type, $args, $glonch) = @{$mbr}{qw(key type iargs glonch)};
                # Several items have a dynamic number of sub-items.  $glonch
		# may be a ref. to a subroutine whose args are $this, and a
		# ref. to the arg list.  It should return a ref to a different
		# array with the real arg list. See Generic::glonch.
	printf STDERR "%s constructor: %s (%s) iargs undef\n", ref($this), $key, $type unless defined($args); #DEBUG
	$args = &{$glonch}($this, $args) if defined($glonch);
	my $val = $type->new($this, $FD, @$args);
	if (defined($val)) {
	    $this->{$key} = $val;
	} else {
	    undef $res;
	    last;
	}
    }
    $this->{end} = $FD->{end}-1;
    $this->{complete} = $res || 0;
    $res;
}

# Adjusts the argument list for the constructor of a sub-object.  Args:
#   $this	Class object ref, the one containing the sub-object.
#   $args	iargs from the object's MEMBERS unit for the sub-object.
#		In the generic case the last 2 members are taken as the key
#		of a Data object in $this, and the subscript therein of the
#		number of content items to stuff.  
#   Returns:	Copy of $args with the last 2 members replaced by the number
#		of items to stuff.
sub glonch {		# Generic
    my($this, $args) = @_;
    my @new = @$args;
    splice(@new, -2, 2, $this->{$args->[-2]}{data}[$args->[-1]]);
    \@new;
}

our $dindent; BEGIN { $dindent = "    "; }	# Add indentation at each level

# Prints a generic object on STDOUT (hardwired).  Args:
#   $this	Class object ref to be printed.
#   $indent	Indentation string.
#   $title	Description to be printed on the first line.
#   @extra	Optional additional stuff to be printed may follow.
#   Returns:	Nothing.
sub print {		# Generic
    my($this, $indent, $title) = splice(@_, 0, 3);
		# (indent) TYPE from START to END: TITLE EXTRA\n"
    printf "%s%s from %o to %o: %s %s\n", 
	$indent, ref($this), $this->{adr}, $this->{end}, $title,
	join(' ', @_);
    $indent .= $dindent;
    my $mbrs; {no strict; $mbrs = \@{ref($this) . "::MEMBERS"}; }
    foreach my $mbr (@$mbrs) {
	my $key = $mbr->{key};
	my $val = $this->{$key};
	if (!defined($val)) {
	    printf "%sObject is incomplete starting at member %s\n", 
		$indent, $key;
	    last;
	} else {
	    $val->print($indent, @{$mbr->{oargs}});
	}
    }
}

# =====
# Generic list of objects.  The class object is a hash with these members in
# addition to the Generic ones:
#   count	Requested number of content objects
#   list	List of content objects

package Listof;
use base "Generic";

# Constructor is inherited from Generic.

# Stuffs a Listof object.  Args: 
#   $this	Ref. to object to be stuffed.
#   $FD		MyFile ref. to read from.
#   $class	Class of the objects to be created.  
#   $count	Number of objects to stuff into the array.
#   Returns:	True if reading succeeded, false (undef) on EOF, dies otherwise.
sub read {		# Listof
    my($this, $FD, $class, $count) = @_;
    my $res = 1;			# Assume reading will succeed.
    $this->{count} = $count;		# Save number of items wanted
    my $list = $this->{list} = [ ];
    while (--$count >= 0) {
	my $item = $class->new($this->{parent}, $FD);
	push(@$list, $item);
	last unless ($res &= $item->{complete});
    }
    $res;
}

# Prints a list on STDOUT (hardwired).  Intended to be part of the printout
# format of another object.  Args:
#   $this	Class object ref to be printed.
#   $indent	Indentation string.
#   $title	Description to be printed on the first line.
#   @extra	Optional additional stuff to be printed may follow.
#   Returns:	Nothing.
sub print {		# Listof
    my($this, $indent, $title) = splice(@_, 0, 3);
    my $list = $this->{list};
		# (indent) N TYPE objects: TITLE EXTRA\n"
    my $count = scalar(@$list);			# The actual count
    printf "%s%d/%d %s objects: %s %s\n", 
	$indent, $this->{count}, $count, 
	($count ? ref($list->[0]) : ""), $title, join(' ', @_);
    $indent .= $Generic::dindent;
    my $j = 0;
    foreach my $item (@$list) {
	$j++;
	$item->print($indent, "$title #$j");
    }
}

# =====
# A list of uninterpretable data.  iargs = its (fixed) length.  It has the
# generic members plus {data}, an array of integers, which is the content.

package Data;
use base 'Generic';

# sub new #Data is inherited from Generic.

# Reads a Data object.  Args:
#   $this	Class object ref. to be stuffed.
#   $FD		MyFile object to read from.
#   $pack	Pack code giving the type of the objects.
#   $length	Number of scalar objects to read.
#   Returns:	True if reading succeeded, false (undef) on EOF, dies otherwise.
sub read {		# Data
    my($this, $FD, $pack, $length) = @_;
    $this->{adr} = $FD->{end};
    my(@data, $val);
    my $res = 1;				# Assume reading will succeed
    $this->{data} = \@data;
    while (--$length >= 0) {
	$val = $FD->readpack($pack);
	if (defined($val)) {
	    push(@data, $val);
	} else {
	    undef $res;
	    last;
	}
    }
    $this->{end} = $FD->{end}-1;
    $this->{complete} = $res || 0;
    $res;
}

# Prints a Data object on STDOUT (hardwired) as integers and chars.  Args:
#   $this	Class object ref to be printed.
#   $indent	Indentation string.
#   $title	Description to be printed on the first line.
#   @extra	Optional additional stuff to be printed may follow.
#   Returns:	Nothing.
sub print {		# Data
    my($this, $indent, $title) = splice(@_, 0, 3);
		# (indent) TYPE from START to END: TITLE EXTRA\n"
    printf "%s%s from %o to %o: %s %s\n", 
	$indent, ref($this), $this->{adr}, $this->{end}, $title, 
	join(' ', @_);
    my $len = 8;			# Length of each line
    my $delta = 0;
    my $adr = $this->{adr};
    my $nl = "";
    print $indent . "(no content items)" unless @{$this->{data}};
    foreach my $v (@{$this->{data}}) {
	if ($delta % $len == 0) {
	    printf "%s%s%4o %4o: ", $nl, $indent, $adr, $delta;
	    $nl = "\n";
	}
	printf " %2x%s", $v, ((ord(' ') lt $v && $v le ord('~')) ? 
						("=" . chr($v)) : "  ");
	$delta++; $adr++;
    }
    print "\n";
}

# =====
# Data object specialized for 5 integer bytes.  Used in VKB.

package Data5;
use base "Data";

# Everything is inherited from Data except:

# Reads a Data object.  Args:
#   $this	Class object ref. to be stuffed.
#   $FD		MyFile object to read from.
#   Returns:	True if reading succeeded, false (undef) on EOF, dies otherwise.
sub read {		# Data
    my($this, $FD) = @_;
    $this->SUPER::read($FD, 'C', 5);
}


# =====
# Unicode string.  Content member is {data}, a string.

package UString;
use base 'Generic';

# sub new #UString is inherited from Generic.

# Reads a UString.  Args: object ref to be stuffed, MyFile ref to read from.
# Returns true if successful, undef at EOF, dies otherwise.
sub read {		# UString
    my($this, $FD) = @_;
    $this->{adr} = $FD->{end};
    $this->{complete} = 0;		# Assume reading will fail
    READ: {
	$this->{data} = "undef";
	$this->{octets} = 0;
		# Read the length byte.
	my $M = $FD->readpack('C');
	last if (!defined($M));
	if ($M & 0x80) {
			# This is a weird one with an array of unicode
			# strings.  The UString is reblessed to be a UArray.
	    $this->{complete} = 1;
	    $this->UArray::read($FD, ($M & 0x7f));
	    last;
	}
	$this->{octets} = $M;
	last if $M < 0;
	if ($M == 0) {
	    $this->{data} = "(empty)";
	    $this->{complete} = 1;
	    last;
	}
		# Read the string itself.
	my $bfr = $FD->readn($M);
	last unless defined($bfr);
	utf8::decode($bfr);
	$this->{data} = $bfr;
	$this->{complete} = 1;
    }
    $this->{end} = $FD->{end}-1;
    $this->{complete} || undef;
}

# Assigns a static string to a UString.
sub assign {		# UString
    my($this, $val) = @_;
    $this->{complete} = 1;
    $this->{data} = $val;
    $this->{octets} = length($val);
}

# Reports the size of the string, suitable for printing.
sub size {
    my($this) = @_;
    sprintf("lengths tot %d oct %d uni %d", 
	($this->{end} + 1 - $this->{adr}), $this->{octets}, length($this->{data}));
}

# Returns the size of the array, as an integer.  (In octets, not unicode chars.)
sub length {
    $_[0]->{octets};
}

# Returns the content as a string suitable for printing.
sub content {
    $_[0]->{data};
}

# Prints a Unicode string on STDOUT (hardwired).  Args:
#   $this	Class object ref to be printed.
#   $indent	Indentation string.
#   $title	Description to be printed on the first line.
#   @extra	Optional additional stuff to be printed may follow.
#   Returns:	Nothing.
sub print {		# UString
    my($this, $indent, $title) = splice(@_, 0, 3);
		# (indent) TYPE from START to END: TITLE EXTRA\n"
    printf "%s%s from %o to %o (%s):\n%s    %s = '%s' %s\n", 
	$indent, ref($this), $this->{adr}, $this->{end}, $this->size(), 
	$indent, $title, $this->content(), join(' ', @_);
}

# =====
# An array of Unicode strings.  Content member is {data}, ref. to a list.

package UArray;
use base 'UString';

# sub new #UArray is inherited from Generic, but you don't call it directly.

# Reads a UArray.  Args: 
#   $this	Object ref to be stuffed -- invariably starts out as a UString,
#		but this subroutine reblesses it to be a UArray.  It's assumed
#		that UString::read() has gotten the initial bytes up to where
#		the string starts, and upon return will handle the post-string
#		byte(s).
#   $FD		MyFile ref to read from
#   $count	Number of Unicode strings to read
# Returns true if successful, undef at EOF, dies otherwise.
sub read {		# UArray
    my($this, $FD, $count) = @_;
    bless($this, "UArray");		# Re-bless $this, very flaky procedure
    $this->{count} = $count;
    my @data;
    $this->{data} = \@data;
    while (--$count >= 0) {
	push(@data, UString->new($this, $FD));
	last unless ($this->{complete} &= $data[-1]->{complete});
    }
    $this->{complete} || undef;
}

# Reports the size of the array, suitable for printing.
sub size {
    my($this) = @_;
    sprintf("lengths tot %d count %d strings %d",
	($this->{end} - $this->{adr}), $this->{count}, 
	scalar(@{$this->{data}}));
}

# Returns the size of the array, as an integer.
sub length {
    $_[0]->{count};
}

# Returns the content as a string suitable for printing.
sub content {
    join(", ", map { $_->content() } @{$_[0]->{data}});
}

# sub print #UArray is inherited from UString.


# ======
# This is a 5 byte unit for one letter.  Hash content is:
#   ltr			The letter as a UString object
#   f0, f1, f4		The unknown surrounding numeric items
#   adr			Its location in the file
package Unit;
use base 'Generic';

# sub new #Unit is inherited from Generic.

# Interpretations of unit bytes:
#   f0	0 for normal 5-char units; 1 on the 1st unit with a weird format.
#   f1	Sum of bits: 1 = alphabetic; 2 = decimal digit; 4 = hex digit; 
#	8 = some punct + digits + W and P; 16 = all punctuation.
#	8 = wp./?+WP#()* 0-9; 16 = @;'!,./:=+^"]<>\[
#   f2	Length in octets of the letter
#   ltr	The letter as one UTF-8 char
#   f4	2 at the left end of a row with a 1.5x wide key; 1 at the right end
#	with a 1.5x wide key.
our(@read, %subs);
BEGIN { 
    %subs = (
	C => sub {	$_[0]->readpack('C'); },
	c => sub {	my($c) = @_;
			return 1 if defined($$c);
			$$c = -1;
			0; },
	U => sub {	UString->new(undef, $_[0]); },
	u => sub {	my($u) = @_;
			return 1 if defined($$u) && ${$$u}{complete};
			$$u = UString->new();
			$$u->assign("undef");
			0; },
    );
    @read = (
	{ key => "f0",  type => 'C', },
	{ key => "f1",  type => 'C', },
	{ key => "ltr", type => 'U', },
	{ key => "f4",  type => 'C', },
    ),
}

# Reads 5 bytes from $FILE and stuffs it into the unit. 
# Returns undef on EOF, 1 if OK.  Call as $unit->read($myfile).
# Special units in the thumb keyboard: 
#   Spacebar letter has zero bytes for the letter.
#   Punctuation button has: f0 = 1, f1 = 0x10, ltr = 0x8c followed by
#	12 punctuations (unicode strings) ending at 0x03 which is f4.
sub read {	# Unit
    my($this, $FD) = @_;
    $this->{adr} = $FD->{end};
    $this->{complete} = 1;
    my $read; {no strict; $read = \@{ref($this) . "::read"}; }
    foreach my $ktl (@$read) {
	my($key, $type) = @{$ktl}{qw(key type)};
	$this->{$key} = &{$subs{$type}}($FD);
	$this->{complete} &= &{$subs{lc($type)}}(\${$this}{$key});
#	print "    $key $type ${$this}{complete} '", (($type eq "U") ? $this->{$key}{data} : $this->{$key}), "'\n"; #DEBUG
    }
    $this->{end} = $FD->{end}-1;
    $this->{complete} || undef;
}

# Prints (on STDOUT) a 5 byte unit.  Args:
#   $this	Class object ref (Unit)
#   $indent	Indentation string
#   @extra	Optional additional stuff to print afterward.
sub print {	# Unit
    my($this, $indent) = splice(@_, 0, 2);
    printf "%s%4o %2x %2x (%d)'%s' %2x\n", 
	$indent, $this->{adr}, $this->{f0},$this->{f1}, 
	$this->{ltr}->length(), $this->{ltr}->content(), 
	$this->{f4}, join(' ', @_);
}


# =====
# One panel of the keyboard.  Content:
#   init	Initial sequence of 6 bytes, as a Data object
#   sizes	Sizes of the 4 rows, as a Data object
#   rows	List of content of rows, which are lists of Units, left to 
#		right order.  There are always 4 rows but some can be empty.
package Panel;
use base 'Generic';

# sub new #Panel is inherited from Generic.

our @MEMBERS; BEGIN {
    @MEMBERS = (
	{   key  => "init", type => "Data", 
	    iargs => ['C', 6], oargs => ["Initial Data"],
	},
	{   key  => "sizes", type => "Data", 
	    iargs => ['C', 4], oargs => ["Row Sizes"],
	},
	{   key  => "row0", type => "Listof",
	    iargs => ["Unit", "sizes", 0], oargs => ["Row 0"],
	    glonch => \&Generic::glonch,
	},
	{   key  => "row1", type => "Listof",
	    iargs => ["Unit", "sizes", 1], oargs => ["Row 1"],
	    glonch => \&Generic::glonch,
	},
	{   key  => "row2", type => "Listof",
	    iargs => ["Unit", "sizes", 2], oargs => ["Row 2"],
	    glonch => \&Generic::glonch,
	},
	{   key  => "row3", type => "Listof",
	    iargs => ["Unit", "sizes", 3], oargs => ["Row 3"],
	    glonch => \&Generic::glonch,
	},
    );
}

# Stuffs the Panel object with its units.  Argument: MyFile object.
# Returns undef if reading failed, 1 if OK.
sub read_OBSOLETE {	# Panel		#DEBUG get rid of
    my($this, $FD) = @_;
    my($j, $rows, @rows);
    $this->Generic::read($FD);		# Read the initial data and row sizes
    return undef unless $this->{complete};
		# Read the rows themselves.
    $rows = $this->{sizes}{data};
    $this->{rows} = \@rows;
    foreach my $jj (@$rows) {
	$j = $jj;
	my @row1;
	while (--$j >= 0) {
	    my $unit = Unit->new($this, $FD);
	    if (!defined($unit)) {
		$this->{complete} = 0;
		last;
	    }
	    push(@row1, $unit);
	}
	push(@rows, \@row1);
	last unless $this->{complete};
    }
    $this->{end} = $FD->{end}-1;
    $this->{complete} || undef;
}

# Prints a Panel object on STDOUT (hardwired).  Args:
#   $this	Class object ref to be printed.
#   $indent	Indentation string.
#   $title	Description to be printed on the first line.
#   @extra	Optional additional stuff to be printed may follow.
#   Returns:	Nothing.
sub print_OBSOLETE {		# Panel	#DEBUG get rid of
    my($this, $indent) = splice(@_, 0, 2);
		# Print the title, the initial data and the row sizes.
    $this->Generic::print($indent, @_);
		# Now print the units themselves.
    $indent .= $Generic::dindent;
    my $indunit = $indent . $Generic::dindent;
		# Print each row.
    my $nrow = 0;
    foreach my $row (@{$this->{rows}}) {
	printf "%sRow %d (%d/%d keys):\n", 
	    $indent, ($nrow+1), $this->{sizes}{data}[$nrow], scalar(@$row);
	foreach my $unit (@$row) {
	    $unit->print($indunit);
	}
	$nrow++;
    }
}

# A complete keyboard is a hash with 2 keys, "alphabetic" and "numeric",
# containing Panel objects for those keyboard panels, and "init" with the
# leading 3 bytes.  All the methods are inherited from Generic.
package Keyboard;
use base 'Generic';

our @MEMBERS; BEGIN {
    @MEMBERS = (
	{   key  => "init", type => "Data", 
	    iargs => ['C', 2], oargs => ["Initial Data"],
	},
	{   key  => "label", type => "UString",
	    iargs => [], oargs => ["Label"],
	},
	{   key  => "panels", type => "Listof", 
	    iargs => ["Panel"], oargs => ["Panel"],
	    glonch => sub {
		my($this, $args) = @_;
		[ @$args, ($this->{parent}{init}{data}[0] ? 1 : 2) ];
	    },
	},
    );
}

# Keyboards come in pairs: a hash with 2 keys, "shift" and "unshift",
# containing Keyboard objects, and "init" with the
# leading bytes.  All the methods are inherited from Generic.
package KeyboardSet;
use base 'Generic';

our @MEMBERS; BEGIN {
    @MEMBERS = (
	{   key  => "init", type => "Data", 
	    iargs => ['C', 4], oargs => ["Initial Data"],
	},
	{   key  => "list", type => "Listof", 
	    iargs => ["Keyboard", "init", 1], oargs => ["Keyboard"],
	    glonch => \&Generic::glonch,
	},
    );
}

# A virtual keyboard contains header information followed by a KeyboardPair.
# Some files appear to have two KeyboardPairs, but the second one is mutated.
# This is for the "thumb keyboard".
package VKB;
use base 'Generic';

our @MEMBERS; BEGIN {
    @MEMBERS = (
	{   key  => "magic", type => "Data", 
	    iargs => ['C', 2], oargs => ["Magic Number"],
	},
	{   key => "lang", type => "UString", 
	    iargs => [], oargs => ["Writing System"],
	},
	{   key  => "locale1", type => "UString", 
	    iargs => [], oargs => ["Locale #1"],
	},
	{   key  => "locale2", type => "UString", 
	    iargs => [], oargs => ["Locale #2"],
	},
	{   key  => "counts", type => "Data",
	    iargs => ['C', 4], oargs => ["Initial Counts"],
	},
	{   key  => "dimensions", type => "Listof",
	    iargs => ["Data5", "counts", 3], oargs => ["Some kind of dimensions"],
	    glonch => \&Generic::glonch,
	},
	{   key  => "variable", type => "Data", 
	    iargs => ['C'], oargs => ["Variable Region"],
	    glonch => sub {
		my($this, $args) = @_;
		[ @$args, (($this->{magic}{data}[1] == 2) ? 3 : 1) ];
	    }
	},
	{   key  => "zero", type => "Data",
	    iargs => ['C', 21], oargs => ["All Zero"],
	},
	{   key  => "keyboards", type => "Listof", 
	    iargs => ["KeyboardSet", "magic", 1], oargs => ["Keyboard Set"],
	    glonch => \&Generic::glonch,
	},
	{   key  => "tail", type => "Data", 
	    iargs => ['C', 16], oargs => ["Following Stuff (if any)"],
	},
    );
}

package main;

# Open the input file.
our $FD = MyFile->new($ARGV[0] || '-');

# Read the content.
our $vkb = VKB->new(undef, $FD);

# Print it out.
$vkb->print("", "Virtual Keyboard");