#!/usr/bin/perl -w
package Ink;
use strict;

#
# These are used with dynamic scoping to provide an easier
# interface for the handlers.
#
use vars qw( $data );

#
# The file format version 0 defines this table of Huffman codes
# that describe the displacement from the original point of placement.
#
my %huffman_table = (
	'110101011111001'	=> -16,
	'110101011110'		=> -15,
	'1100100100'		=> -14,
	'110010011'		=> -13,
	'110101010'		=> -12,
	'11010100'		=> -11,
	'1000100'		=> -10,
	'1010011'		=> -9,
	'1101011'		=> -8,
	'101000'		=> -7,
	'110011'		=> -6,
	'10000'			=> -5,
	'11000'			=> -4,
	'11011'			=> -3,
	'1011'			=> -2,
	'010'			=> -1,
	'00'			=> 0,
	'011'			=> 1,
	'1001'			=> 2,
	'10101'			=> 3,
	'110100'		=> 4,
	'100011'		=> 5,
	'1100101'		=> 6,
	'1010010'		=> 7,
	'11001000'		=> 8,
	'10001010'		=> 9,
	'100010111'		=> 10,
	'100010110'		=> 11,
	'1100100101'		=> 12,
	'11010101110'		=> 13,
	'11010101100'		=> 14,
	'11010101101'		=> 15,
	'1101010111111'		=> 16,
	'11010101111101'	=> 18,
	'11111111'		=> undef,
);


sub process_huffman {
	my $len = $data->get_int( 2 );
	my $x = $data->get_int( 2 );
	my $y = $data->get_int( 2 );

	#print "Stroke data (1): (x,y)=($x,$y) of length $len\n";

	my $n = '';
	my $v;
	my $count = 0;
	my $points = 0;
	my @points;
	my $dx;
	my $bytes_read = 0;
	my $last_v = 0;

	push @points, [$x,$y];

	while($data->remaining and $bytes_read <= $len) {
		unless( --$count > 0 ) {
			$v = $data->get_int( 1 );
			last if $v == 0xff and $last_v == 0xff;

			$count = 8;
			$bytes_read++;
			$last_v = $v;
		}

		$n .= ($v&0x80) ? '1' : '0';
		$v <<= 1;

		if( exists $huffman_table{$n} ) {
			my $dist = $huffman_table{$n};
			if( defined $dx ) {
				$x += $dx;
				$y += $data->{y_scale}*$dist;
				push @points, [$x,$y];
				undef $dx;
			} else {
				$dx = $dist;
			}
			
			$n = '';
		}
	}

	# We hit two ff's or ran out of data

	my $p = get_int( $data, 2 );

	unless( @points ) {
		print "Out of points: $p\n";
	}

	( 'Stroke', 'num' => $p, 'points' => \@points );
};


#
# The files consist of a stream of objects that describe attributes
# of the file, pen strokes, etc.  The objects are tagged with a one
# byte id that we use to index into the table of handlers.  Each
# entry in the table should be structures as
#	key	=> [ 'object name', handler ],
# The return result of the handler will be blessed to the class
# of the object for the user to deal with.
#
my %object_types = (
	# Huffman encoded stroke data
	'0x01' => \&process_huffman,
	'0x02' => \&process_huffman,

	# Page number: Stored in msb format.  4 bytes
	'0x04' => sub { 		'Page Number',
		'page_number'	=> $data->get_int( 4 ),
	},
		
	# Attributes
	# Most of these are unknown.  The first 11 bytes are
	# constant.  The last byte is the Huffman encoding system
	'0x06' =>  sub { 	'Huffman Encoding',
		'unknown'	=> $data->get_string( 11 ),
		'encoding'	=> $data->get_int( 1 ),
	},

	# Believed to be the filname of the document
	'0x0a' => sub { 	'Filename',
		'filename'	=> $data->get_string( 8 ),
	},

	# Tablet type (1 byte)
	# 3 == Crosspad
	'0x0e' => sub { 	'Tablet Type',
		'type'		=> $data->get_int( 1 ),
	},

	# Title?  Unknown functionality
	'0x0d' => sub { 	'Document',
		'title'		=> $data->get_string( 8 ),
	},
			
	# XP Attribute set
	# First byte is the Huffman encoding.  The rest of
	# the meaning is unkown.
	'0x1d' => sub { 	'Huffman Encoding',
		'encoding'	=> $data->get_int( 1 ),
		'unknown'	=> $data->get_string( 36 );
	},

	# Unknown
	'0x20' => sub { 	'Unknown',
		'unknown'	=> $data->get_string( 38 ),
	},

	# Last download date
	'0x3a' => sub { 	'Download Date',
	},
);

sub Make_Update($&)
{
	my $class = shift;
	my $sub = shift;
	no strict 'refs';

	*{"Ink::${class}::update"} = $sub;
}

Make_Update 'Huffman Encoding', sub {
	my $obj		= shift;
	my $data	= shift;
	print "New encoding: $obj->{encoding}\n";
	$data->{y_scale} =
		$obj->{encoding} == 0 ? 1	:
		$obj->{encoding} == 1 ? -1	:
		$obj->{encoding} == 2 ? 1	:
		die "Unknown Huffman encoding $obj->{encoding}\n";
};

Make_Update 'Page Number', sub {
	my $obj		= shift;
	my $data	= shift;
	print "New page: $obj->{page_number}\n";
	$data->{page_number} = $obj->{page_number};
};

	

sub Next
{
	# This is dynamically scoped to simplify the object
	# handling code.  It is a deliberate choice.
	local ($data) = @_;

	return unless $data->remaining;

	# Always zero
	$data->get_int( 4 );

	my( $obj_id, $month,$day,$year, $hour,$min,$sec );

	for( $obj_id, $month, $day, $year, $hour, $min, $sec ) {
		$_ = sprintf "%02x", $data->get_int( 1 );
	}

	my $handler = $object_types{"0x$obj_id"}
		or die "Unknown object type 0x$obj_id\n";

	my ($type,%values) = $handler->();
	$values{date} = "$year/$month/$day $hour:$min:$sec";

	my $obj = bless \%values, "Ink::$type";
	$obj->update($data) if can $obj 'update';

	$obj;
}

sub new {
	my $class = ref $_[0] ? ref shift : shift;

	bless {
		y_scale		=> -1,
		page		=> 1,
		data		=> \$_[0],
		index		=> 0,
	}, $class;
}


sub get_int
{
	my $data	= shift;
	my $len		= shift;
	my $v		= 0;

	while( $len-- ) {
		$v = ($v<<8)
		   | ord substr ${$data->{data}}, $data->{index}++, 1;
	}

	$v
}

sub get_string
{
	my $data	= shift;
	my $len		= shift;

	my $s = substr ${$data->{data}}, $data->{index}, $len;
	$data->{index} += $len;

	$s;
}

sub remaining
{
	my $data	= shift;
	$data->{index} < length(${$data->{data}});
}

1


