#!/usr/bin/perl
#{([
use strict;
use File::Basename;
use Getopt::Std;
use Data::Dumper;
   
use Font::TTF::Font;
use Font::TTF::OTTags qw( %ttnames readtagsfile);

our ($opt_a, $opt_d, $opt_g, $opt_l, $opt_r, $opt_s, $opt_t, $opt_v, $VERSION);

$VERSION = '0.53';

my $progname = basename ($0);
$progname =~ s/\.[^.]+$//;

getopts('ad:g:l:rst:v:');

die <<"EOT" unless $#ARGV >= 0 and $#ARGV <= 1;;

$progname -- create VOLT project from existing OpenType font file

syntax: $progname [options] infontfile [outfontfile]

Attempts to create a VOLT project from an existing OpenType font by reading and
interpreting the existing GDEF, GPOS, and GSUB tables. Not every OpenType
rule can be mimiced in VOLT; warnings are issued when $progname cannot
handle something.

In normal usage, specify either outfontfile (to create a font
ready to be opened by VOLT) and/or the -v option (to create a
VOLT project source that can be imported into the font).

options:
    -a        allow non-adobe glyph names
    -g n      group creation threshold
    -l file   emit log messages to named file
    -r        retain GPOS, GSUB, and GDEF tables in output font
    -s        do not send warnings to stdout (will still go to log)
    -t file   name of replacement VOLT tags file if needed.
    -v file   Volt project source (.vtp) file to create
    
The group creation threshold option sets the minimum number of glyphs
that $progname will put into a group for the purposes of building
a lookup.

Lookups currently supported  (type[.format]):

GSUB:   1 2 3 4   6.3
GPOS    1 2 3 4 5     8.3

Version $VERSION
EOT


my $font;							# Font structure
my ($cmap, $post, $gsub, $gpos, $gdef);	# Various tables in font

my $g;		# Glyph structure

# MAJOR TO-DO: Someday this should all be rewritten to generate the internal datastructure used by Volt.pm.  Then this
# would become a library module and command-line option for make_volt.  Some day.

# Glyph data are stored in structures (anonymous hashes) containing the following elements (all optional):
#	ID			glyph ID
#	NAME		glyph name, derived from postname
#	@UNICODES	an array of Unicode values
#	COMPONENTS	a count of ligature components
#	TYPE		one of BASE, MARK, LIGATURE, COMPONENT (from GDEF if present)
#   ANCHORS     a hash of attachment points, indexed by attachment point name, value is a pointer to an Font::TTF::Anchor 

# Gyph structures can be located from glyph ID, PS name or, for encoded glyphs, USV:
my (%GlyphFromID, %GlyphFromName, %GlyphFromCmapUnicode);

my ($gid, $gname, $u);	# Glyph ID, Glyph name, and Unicode

my ($SLFText, $LookupText);		# generated VOLT source texts: Script/Lang/Feature, Lookups

my ($warningCount, $genericCount);

# Open log file
open(LOG, ">$opt_l") if $opt_l;

# Sub to print warning messages to console and log. 1st parm is the message.
# 2nd param, if supplied, is a line number.

sub MyWarn {
	my ($msg, $line) = @_;
	$warningCount++;
	if (defined $line) {
		print LOG "line $line: " . $msg;
		warn "line $line: " . $msg unless $opt_s;
	} else {
		print LOG $msg;
		warn $msg unless $opt_s;
	}
}



##########################
# Open the font and verify presence of needed tables

$font = Font::TTF::Font->open($ARGV[0]) or die "Could not open font '$ARGV[0]'\n";

exists $font->{'post'} or die "Could not locate Postscript name info in font '$ARGV[0]\n" ;
$post = $font->{'post'}->read;
$cmap = $font->{'cmap'}->find_ms or die("Unable to locate Windows cmap in font '$ARGV[0]'\n");

$gdef = $font->{'GDEF'}->read if exists $font->{'GDEF'};
$gsub = $font->{'GSUB'}->read if exists $font->{'GSUB'};
$gpos = $font->{'GPOS'}->read if exists $font->{'GPOS'};

die "None of GDEF, GSUB, GPOS tables found in font '$ARGV[0]' \n  -- you probably don't need to use $progname\n" unless $gdef || $gsub || $gpos;

# $font->out_xml($opt_d, 'GSUB') if defined $opt_d;
if ($opt_d)
{
    open (DUMP, ">$opt_d")  or die "Couldn't open '$opt_d' for writing.";
    my $res;
    if (0)
    {
        # I wish this could work!  But sometimes Perl abends
        my $d = Data::Dumper->new([$gsub, $gpos, $gdef], [ qw(gsub gpos gdef)]);
        sub myfilter
        {
            my ($hash) = @_;
            my @a = grep {$_ ne ' PARENT'} (keys %{$hash}) ;
            return [ @a ];
        }
        $d->Sortkeys(\&myfilter);
        $d->Indent(3);  # I want array indicies
        $res = $d->Dump;
        $d->DESTROY;
    }
    else
    {
        $Data::Dumper::Indent = 3;
        $res = Dumper($font);
    }
    $res =~ s/  / /g;
    print DUMP $res;
    close DUMP;
    
}



##########################
# Build Glyph structure based on postscript names and cmap values.

# Note: This algorithm has to match that in VoltFixup.pl if the source
# generated by this program is going to be spliced into a modified font.
# In fact, this code is adapted from VoltFixup.pl!


# loop through all glyphs, setting up glyph structure.


GLYPH: for $gid (0 .. $font->{'maxp'}{'numGlyphs'}-1) 
{
	$gname = $post->{'VAL'}[$gid];

	# $gname = "glyph$gid" unless defined $gname;
	
	($gname eq '.notdef')			&& do {
		# no PS name
		next GLYPH;
		};
	
	($gname !~ /^[a-zA-Z][a-zA-Z0-9_.]*$/)	&&  do {
		MyWarn "Glyph $gid has non-standard psname '$gname'\n";
		next GLYPH unless $opt_a;
		};

    # Only letters, digits, '.' and '_' are allowed in VOLT names
    $gname =~ s/[^\w.]/_/og;

	(exists $GlyphFromName{$gname})		&& do {
		MyWarn "Glyph name '$gname' is used more than once in font  (e.g., glyphs $GlyphFromName{$gname}{'ID'} and $gid) -- second ignored\n";
		next GLYPH;
		};

	# Ah, here is a name worth keeping!
	$g = $GlyphFromID{$gid} = $GlyphFromName{$gname} = { ID => $gid, NAME => $gname};

	if (defined $gdef) 
	{
		# Look up type in GDEF table
		my $type = $gdef->{'GLYPH'}{'val'}{$gid};
		$g->{'TYPE'} = (qw(BASE LIGATURE MARK COMPONENT))[$type-1] if $type > 0;
	}
}

#Initialize groups from gdef marks classes...
InitGroups();


# Some things not yet handled from GDEF:
if (defined $gdef)
{
    foreach (qw (ATTACH LIG))
    {
        MyWarn "GDEF $_ information not implemented\n" if exists $gdef->{$_} && $gdef->{$_}{'COVERAGE'}{'count'} > 0;
    }
}


# loop through the MS cmap and adding in Unicode info to %Glyph

CMAP: while (($u, $gid) = each %{$cmap->{'val'}}) 
{

	if (exists $GlyphFromCmapUnicode{$u}) {
		MyWarn sprintf ("Corrupt cmap: Unicode value U+%04X occurs more than once\n", $u);
		next CMAP;
	}

	if (exists $GlyphFromID{$gid}) {
		# Glyph with this id already present:
		$g = $GlyphFromID{$gid};
	} else {
		# Glyph with this id not yet present (must not have had a usable PS name), so create it:
		$g = $GlyphFromID{$gid} = { ID => $gid};
	}

	$g->{'@UNICODES'} = [] if not exists $g->{'@UNICODES'};	# Create array to hold Unicode values
	push @{$g->{'@UNICODES'}}, $u;		# Add to array of Unicode values
	$GlyphFromCmapUnicode{$u} = $g;		# Be able to find glyph via cmap from Unicode
}


# Try to locate and read VOLT tags.txt file to find names for Scripts, Languages, and Features:
if (defined $opt_t)
{
    MyWarn "Cannot open VOLT tags file '$opt_t'\n" unless readtagsfile($opt_t);
}


##########################
#   InitGroups()
#	CacheGroup()
#	GetGroup()
#	GetGroupNames()
#
# Routines to create and manage glyph groups from lists of GIDs.
# Groups are numbered from 0. Groups 0 through $maxMarkClass are actually the
# mark classes defined in GDEF and, therefore, are named "Class0", "Class1", etc.
# Beyond that, groups are created as needed for any specific list of GIDs. 
# Such groups are named, simply, "Group3", "Group4", etc.
#
# InitGroups()
#   Set first n groups based on GDEF MARKs class definition
#
# CacheGroup()
#	Accept a list of GIDs 
#	Return the name of a group.
#	If the group already exists, return its name. Else create the group
#
# GetGroup()
#	Accept a group name
#	Return a list of GIDs
#
# GetGroupNames()
#	returns a list of the names of defined groups.
#
# Current implementation:
# Groups are maintained in an array. The name of the group is implied by its index, e.g. "Group001"
# Each array element is simply the GID's join'd together by ":"
#

my @Groups;		    # Array of groups. See CacheGroup()
my $maxMarkClass;    # Highest Groups index that represents a MARK class

sub InitGroups()
{
    # initialize groups list from GDEF class...

    return unless defined $gdef && exists $gdef->{'MARKS'};
    die "Unexpected call to InitGroups\n" if $#Groups != -1 || $maxMarkClass > 0;

    my @classlist = ClassToLists ($gdef->{'MARKS'});
    $maxMarkClass = $#classlist;
    for my $class (0 .. $maxMarkClass)
    {
        $Groups[$class] = join (":", @{$classlist[$class]}) if defined $classlist[$class];
    }
}


sub CacheGroup(@)
{
	my ($i, $tmp);
	$tmp = join (":", sort {$a <=> $b} @_);
	for $i (0 .. $#Groups)
	{
		return GetGroupName($i) if $tmp eq $Groups[$i];
	}
	# Not in the cache, so add it:
	push @Groups, $tmp;
	return GetGroupName($#Groups);
}

sub GetGroup($)
{
	my $i = shift;
	$i =~ s/^\D*//;	# strip leading non-digits
	die "Invalid Group index $i." if $i < 0 or $i > $#Groups;
	return (split(":", $Groups[$i]));
}

sub GetGroupNames()
{
	return (map {GetGroupName($_) } (0 .. $#Groups));
}

sub GetGroupName($)
{
    my $i = shift;
	die "Invalid Group index $i." if $i < 0 or $i > $#Groups;
    return $i <= $maxMarkClass ? "Class$i" : "Group$i";
}

##########################
#	GetGroupRange()
#
# This is one of the more complicated subs. It is used to partition the rules for a given lookup
# into collections of rules that can be written with a group notation. 
#
# Note: This routine is written using the notation of "lhs" and "rhs" as if the lookup were GPOS type 2. That
# is the lhs of each rule is a single glyph, the rhs is a sequence of glyphs. However, the routine is
# equally usable for type 4 lookups by reversing the sense of the parameters. From a notational standpoint
# it is easier just to think of lhs & rhs
#
# The input can be thought of as column of single GIDs, each element [or row] representing the lhs of a type 2
# lookup (or the rhs of a type 4 lookup), and a 2-D matrix of GIDs each row representing the rhs 
# of type 2 lookup (or the lhs of a type 4 lookup). The first of these ($lhs) is passed as a 
# reference to an array,the second ($rhs) as a reference to an array of references to arrays (an "LOL")
#
# The only other parameter is a starting row index ($start). The routine looks at the consecutive rows
# in the input data to determine how many can be collected together into one rule. One of the return
# parameters is the ending row of the collection, which can then be incremented and passed back in
# as the start value to look for another group.
#
# More specifically, the return value is a list containing:
#
#	$last	index of the last row of the data is part of the collection; may be same as $start
#	$col	column index in $rhs indicating which of the items in the sequences of the group varies
#				(will be -1, if $end == $start)
#	$lhsGroup	name of a group representing the lhs glyphs, e.g., @{$lhs}[$start .. $last]; may be undef
#	$rhsGroup	name of a group representing the glyphs in $rhs column, i.e., @{$rhs}[$start .. $last][$col]; may be undef

sub GetGroupRange(\@\@$)	# @lhs, @rhs, $start
{
	my ($lhs, $rhs, $start) = @_;
	my ($last, $col, $lhsGroup, $rhsGroup);		# Return values
	my ($lastcol, $i);

	$lastcol = $#{$rhs->[$start]};	# last column index in sequence at row $start

ROWLOOP:
	for ($last = $start + 1; $last <= $#{$lhs}; $last++)		# For loop used so $last retains value on exit of loop
	{
		# Verify lhs GID is strictly ascending order (must be so for a valid group)
		last if $lhs->[$last] <= $lhs->[$last-1];

		# Verify that the length of this row's rhs sequence is the same as $start's:
		last if $#{$rhs->[$last]} != $lastcol;

		# Locate the varying column (there can be only one!)
		for $i (0 .. $lastcol)
		{
			# If glyph is same as on $start row, then try next column
			next if $rhs->[$start][$i] == $rhs->[$last][$i];

			# If we already know the column, and this isn't it, then this
			# row cannot be part of the collection. Also, if the GID isn't
			# strictly ascending then this row cannot be part of the collection:
			last ROWLOOP if ((defined $col) && ($i != $col)) || ($rhs->[$last][$i] <= $rhs->[$last-1][$i]);

			# Remember the target column:
			$col = $i if not defined $col;
		}
	}

	if (!defined $col || ($last - $start + 1) < $opt_g)
	{
		# Cannot build a group:
		$last = $start;
	}
	else
	{
		# At this point, $last is one greater than the last row that can be part
		# of the group, so adjust it:
		$last -=1;
	}

    
	if ($last > $start)
	{

		# Construct groups
		$lhsGroup = CacheGroup (@{$lhs}[$start .. $last]);
		$rhsGroup = CacheGroup (map { $rhs->[$_][$col]} ($start .. $last));
	}
	else
	{
		# Make sure $col won't match any column:
		$col = -1;
	}
	
	# Done!
	return ($last, $col, $lhsGroup, $rhsGroup);
}

##########################
# ClassToLists()
#
# Given a Class table, return an array (indexed by class value) of arrays of GIDS (in ascending order)

sub ClassToLists($)		# reference to Font::TTF coverage table structure
{
	my $c = shift;

	# Make sure this is a class table and not a cover definition:
	die "ClassToList() not given a class table." if $c->{'cover'} == 1;
	
	my @res;
	
	foreach my $gid (sort {$a <=> $b} keys %{$c->{'val'}})
	{
	    my $classvalue = $c->{'val'}{$gid};
	    $res[$classvalue] = [] unless defined $res[$classvalue];
	    push @{$res[$classvalue]}, $gid;
	}

	return @res;
}


##########################
# CoverToList()
#
# Given a Coverage table, return an array of GIDS in correct order

sub CoverToList($)		# reference to Font::TTF coverage table structure
{
	my $c = shift;

	# Make sure this is a coverage table and not a class definition:
	die "CoverToList() not given a coverage table." if $c->{'cover'} != 1;

	return (sort {$c->{'val'}{$a} <=> $c->{'val'}{$b}} keys %{$c->{'val'}});
}


##########################
# NameFromID()
#
# Routine to get glyph name from ID, 
# 
# if postscript name not defined in font, make one up but issue warning

sub NameFromID($)	# GID
{
	my $gid = shift;
	if (!exists $GlyphFromID{$gid}->{'NAME'})
	{
		my $uname;
		$uname = sprintf (" (U+%04X)", $GlyphFromID{$gid}->{'@UNICODES'}[0]) if exists $GlyphFromID{$gid}->{'@UNICODES'};
		
		MyWarn ("Glyph $gid$uname is used but doesn't have a name -- making one up.\n");
		$GlyphFromID{$gid}->{'NAME'} = "glyph$gid";
		$genericCount++;
	}
	return $GlyphFromID{$gid}->{'NAME'};
}

##########################
# GlyphOrGroup
#
# Many lookups allow either GROUP or GLYPH depending on whether one or many glyphs are included.
# This function takes a list of GIDS and creates the appropriate GROUP or GLYPH needed.
#

sub GlyphOrGroup
{
    if (scalar(@_) > 1)
    {
        return "GROUP \"" . CacheGroup(@_) . "\"";
    }
    else
    {
        return "GLYPH \"" . NameFromID($_[0]) . "\"";
    }
}



##########################
# WriteLookupHeader()
#
# Routine to generic lookup header to $LookupText
#

sub WriteLookupHeader ($$)		# lookup structure reference, name to be used in lookup
{
	my ($l, $name) = @_;	
	$LookupText .= "DEF_LOOKUP \"$name\"";
	# At one time I thought VOLT might be sensitive to the order these were written in, but now I don't think so.
	# In any case, this seems to be the order VOLT itself writes:

	# set SKIP_BASE only if *both* IgnoreBaseGlyphs and IgnoreLigatures bits set:
	$LookupText .= ($l->{'FLAG'} & 0x0006) == 0x0006 ? " SKIP_BASE" : " PROCESS_BASE";
	$LookupText .= ($l->{'FLAG'} & 0x0008) ? " SKIP_MARKS" : " PROCESS_MARKS " . ($l->{'FLAG'} & 0xFF00 ? GetGroupName($l->{'FLAG'}>>8) : "ALL");
	$LookupText .= " DIRECTION " . ($l->{'FLAG'} & 0x0001 ? "RTL" : "LTR");
	MyWarn (sprintf "Lookup $name has unhandled lookup flag bits 0x%04X\n", $l->{'FLAG'} & 0xF0) if $l->{'FLAG'} & 0xF0;
	$LookupText .= "\n";

}


##########################
# GetContext()
#
# Return a string representing the context 

sub GetContext($$)       # subtable and either 'PRE' or 'POST' 
{
    my ($sub, $which) = @_;
    
    my $res;
    
    foreach my $ctx ($which eq 'PRE' ? reverse (@{$sub->{'RULES'}[0][0]{$which}}) : @{$sub->{'RULES'}[0][0]{$which}} )
    {
        $res .= $which eq 'PRE' ? ' LEFT ' : ' RIGHT ';
        if ($sub->{'MATCH_TYPE'} eq 'o')
        {
            # Cover-based context -- but if just one glyph in the cover let's do it as a glyph
            $res .= GlyphOrGroup (keys %{$ctx->{'val'}}) . "\n";
        }
        else
        {
            MyWarn "MATCH_TYPE is '$sub->{'MATCH_TYPE'}' rather than expected 'o' in GetContext.\n";
        }
    }
            
    return $res;
}

##########################
# CoalesceChainContextSubtables()
#
# Chaining Context Lookups (GSUB 6, GPOS 8) need some preprocessing to coalesce adjacent subtables a into single VOLT lookup.
# While this step isn't actually needed for some situations, it is required as part of the support for "EXCEPT_CONTEXT".
# The way EXCEPT_CONTEXT works is to split the single VOLT lookup into multiple subtables where the first has zero actions but
# does have all the context, the second has no context but does have all the action. Since there is no way to express this
# in VOLT as two separate lookups (can't have zero actions), we have to coalesce these subtables.
#
# VOLT also uses separate subtables for normal "IN_CONTEXT" rules when there are multiple contexts of differing lengths.
# These wouldn't have to be coalesced into a single VOLT lookup, but since we have to handle the EXCEPT_CONTEXT we may as well
# do it all.
#
# So the following routine preprocesses the subtables of a lookup to coalesce such subtables and generate the context strings.
#

sub CoalesceChainContextSubtables ($$)
{
    my $l = shift;      # ref to chaining context lookup structure
    my $parent = shift; # ref to GSUB or GPOS table
    
    my $name = $l->{'-name'};
 
    # Loop through the subtables. 
    # Loop is constructed this way because I may be deleting subtables as I go through
    my $subtbl;
	for ($subtbl = 0; $subtbl < scalar (@{$l->{'SUB'}});   )    
	{
	    my $sub = $l->{'SUB'}[$subtbl];
	    if ($sub->{'FORMAT'} != 3) 
	        { MyWarn "Lookup '$name' has unhandled subtable format $sub->{'FORMAT'} -- ignoring subtable.\n"; splice (@{$l->{'SUB'}}, $subtbl,1); next;}
   		
   		# I don't think it is possible to have more than one RULES entry, but if a font shows
   		# up with this I want to know about it...
   		if ($#{$sub->{'RULES'}} > 0)
        	{ MyWarn "Font has more than one RULES entry for lookup '$name' (type $l->{'TYPE'} format $sub->{'FORMAT'}) -- ignoring subtable\n"; splice (@{$l->{'SUB'}}, $subtbl,1); next;}
        
        # Don't ask me why Martin has another array in the structure at this point, but he does:
        if ($#{$sub->{'RULES'}[0]} > 0)
		    { MyWarn "Font has more than one RULES[0] entry for lookup '$name' (type $l->{'TYPE'} format $sub->{'FORMAT'}) -- ignoring subtable\n"; splice (@{$l->{'SUB'}}, $subtbl,1); next;}

		# For now, cannot handle more than one ACTION item
		if ($#{$sub->{'RULES'}[0][0]{'ACTION'}} > 0)
		    { MyWarn "Font has more than one ACTION entry for lookup '$name' (type $l->{'TYPE'}  format $sub->{'FORMAT'}) -- ignoring subtable\n"; splice (@{$l->{'SUB'}}, $subtbl,1); next;}

		# In order to coalesce two subtables, the MATCH of the two subtables must be equivalent, and if both subtables have an Action, then that must match
        # So we'll calculate $matchID and $lookupID, two values that we can compare with previous and next lookups.
        # While we're at it we'll format the context strings
        
        my ($lookupID, $context, $matchID);
        
        # Start by building $lookupID from the ACTION.
        if (defined $sub->{'RULES'}[0][0]{'ACTION'}[0])
        {
            # This has a rule, so it isn't an EXCEPT_CONTEXT subtable.
       		my ($offset, $ti) = @{$sub->{'RULES'}[0][0]{'ACTION'}[0]};
    		unless (defined $ti)
    		    { MyWarn "OOPS: ACTION not defined in lookup '$name' (type $l->{'TYPE'}  format $sub->{'FORMAT'}) -- ignoring subtable\n"; splice (@{$l->{'SUB'}}, $subtbl,1); next;}

    		# For now, offset must be 0 and target rule must not be anything complex 
    		if ($offset != 0)
    		    { MyWarn "Font has nonzero ACTION offset for lookup '$name' (type $l->{'TYPE'} format $sub->{'FORMAT'}) -- ignoring subtable\n"; splice (@{$l->{'SUB'}}, $subtbl,1); next;}
    		
    		if ($parent->{'LOOKUP'}[$ti]{'TYPE'} > (ref ($parent) eq 'Font::TTF::GSUB' ? 4 : 6))
    		    { MyWarn "Font has complex lookup in ACTION entry for lookup '$name' (type $l->{'TYPE'} format $sub->{'FORMAT'}) -- ignoring subtable\n"; splice (@{$l->{'SUB'}}, $subtbl,1); next;}
    		
    		if ($#{$parent->{'LOOKUP'}[$ti]{'SUB'}} > 0)
    		    { MyWarn "Font has multi-subtable lookup in ACTION entry for lookup '$name' (type $l->{'TYPE'} format $sub->{'FORMAT'}) -- ignoring subtable\n"; splice (@{$l->{'SUB'}}, $subtbl,1); next;}
    		$lookupID = $ti;
    		$context = "IN_CONTEXT\n";
        }
        else
        {
            # This has no rule, so it is an EXCEPT_CONTEXT subtable.
            $context = "EXCEPT_CONTEXT\n";
        }
        
		# Finish constructing the context string:
		$context .= GetContext ($sub, 'PRE')  if exists $sub->{'RULES'}[0][0]{'PRE'};
        $context .= GetContext ($sub, 'POST') if exists $sub->{'RULES'}[0][0]{'POST'};
        $context .= "END_CONTEXT\n";
        
		# Now, calculate a string which uniquely describes this subtable's match sequence:
		my $matchID = '|';
		foreach my $ctx (@{$sub->{'RULES'}[0][0]{'MATCH'}})
		{
		    if ($sub->{'MATCH_TYPE'} eq 'o')
		    {
		        $matchID .= join(',', sort {$a <=> $b} keys %{$ctx->{'val'}}) . '|';
		    }
	        else
            {
                MyWarn "MATCH_TYPE is '$sub->{'MATCH_TYPE'}' rather than expected 'o' in CoalesceChainContextSubtables.\n";
            }
        }
        
        # See if we can coalesce this subtable with the previous one:
        
        if ($subtbl > 0 &&
            $l->{'SUB'}[$subtbl-1]{'-matchID'} eq $matchID &&
            (!defined $l->{'SUB'}[$subtbl-1]{'-lookupID'} || ($l->{'SUB'}[$subtbl-1]{'-lookupID'} eq $lookupID)))
        {
            # Whoo hoo! we can coalesce them:
            # First, concatinate its context with ours
            $context = $l->{'SUB'}[$subtbl-1]{'-context'} . $context;
            # Now blow it away!
            splice (@{$l->{'SUB'}}, $subtbl-1, 1) ;
        }
        else
        {
            # Couldn't coalesce, so be sure to bump loop variable for next pass:
            $subtbl++;
        }
        
        # Finally, store my private data into this subtable:
        $sub->{'-matchID'} = $matchID;
        $sub->{'-context'} = $context;
        $sub->{'-lookupID'} = $lookupID;
    }
} 



##########################
# WriteSimpleGSUBLookup()
#
# Routine to append a simple GSUB lookup (types 1 - 4) subtable to $LookupText
#

sub WriteSimpleGSUBLookup ($$$)		# lookup structure reference, name to be used in lookup, subtable index
{
	my ($l, $name, $stbl) = @_;

	my ($lhs, $rhs, $start, $last, $col, $lhsGroup, $rhsGroup);
	my ($cover, $i, $subrule);
	
	my $sub = $l->{'SUB'}[$stbl];
	
	if ($l->{'TYPE'} == 1)
	{
		# 1-1 (simple) substitution

        MyWarn ("Unexpected ACTION_TYPE '$sub->{'ACTION_TYPE'}' for lookup '$name'.\n") if $sub->{'ACTION_TYPE'} !~ /[og]/;

		if ($sub->{'FORMAT'} == 1 || $sub->{'FORMAT'} == 2)
        {
    		# Build $lhs and $rhs arrays:
    		$lhs = [ CoverToList ($l->{'SUB'}[$stbl]{'COVERAGE'}) ];
    		$rhs = ($sub->{'FORMAT'} == 1) ?
    			[ map { [ $lhs->[$_] + $sub->{'ADJUST'} ] } (0 .. $#{$lhs}) ]:		# Format 1
    			[ map { $sub->{'RULES'}[$_][0]{'ACTION'} } (0 .. $#{$lhs})  ];		# Format 2
    
    		# Write out the substitution rules:
    		$start = 0;
    		while ($start <= $#{$lhs})
    		{
    			($last, $col, $lhsGroup, $rhsGroup) = GetGroupRange(@{$lhs}, @{$rhs}, $start);
    			if ($last > $start)
    			{
    				# Write rule with groups:
    				$LookupText .= "SUB GROUP \"$lhsGroup\"\n";
    				$LookupText .= "WITH GROUP \"$rhsGroup\"\n";
    			}
    			else	
    			{
    				# Write rule with glyphs:
    				$LookupText .= "SUB GLYPH \"" . NameFromID($lhs->[$start]) . "\"\n";
    				$LookupText .= "WITH GLYPH \"" . NameFromID($rhs->[$start][0]) . "\"\n";
    			}
    			$LookupText .= "END_SUB\n";
    			$start = $last+1;
    
    		}
    	}
    	else
		{
		    MyWarn "GSUB '$name' has unrecognized format $sub->{'FORMAT'}.\n"; 
		}

	}
	elsif ($l->{'TYPE'} == 2)
	{
		# 1-n (multiple) substitution

        MyWarn ("Unexpected ACTION_TYPE '$sub->{'ACTION_TYPE'}' for lookup '$name'.\n") if $sub->{'ACTION_TYPE'} ne 'g';

		if ($sub->{'FORMAT'} == 1)
        {
    		# Build $lhs and $rhs arrays:
    		$lhs = [ CoverToList ($sub->{'COVERAGE'}) ];
    		$rhs = [ map { $sub->{'RULES'}[$_][0]{'ACTION'} } (0 .. $#{$lhs}) ];
    
    		# Write out the substitution rules:
    		$start = 0;
    		while ($start <= $#{$lhs})
    		{
    			($last, $col, $lhsGroup, $rhsGroup) = GetGroupRange(@{$lhs}, @{$rhs}, $start);
    			$LookupText .= "SUB " . ($last > $start ? "GROUP \"" . $lhsGroup : "GLYPH \"" . NameFromID($lhs->[$start])) . "\"\n";
    			$LookupText .= "WITH " . join(" ", map {$_ == $col ? "GROUP \"$rhsGroup\"" : "GLYPH \"" . NameFromID($rhs->[$start][$_]) . "\"" } (0 .. $#{$rhs->[$start]}) ) . "\n";
    			$LookupText .= "END_SUB\n";
    			$start = $last+1;
 		    }
 		}
        else
		{
		    MyWarn "GSUB '$name' has unrecognized format $sub->{'FORMAT'}.\n" ;
		}
	}
	elsif ($l->{'TYPE'} == 3)
	{
		# 1-n (alternate) substitution

	    MyWarn ("Unexpected ACTION_TYPE '$sub->{'ACTION_TYPE'}' for lookup '$name'.\n") if $sub->{'ACTION_TYPE'} ne 'a';

		if ($sub->{'FORMAT'} == 1)
		{
    		$lhs = [ CoverToList ($sub->{'COVERAGE'}) ] ;
    		$rhs = [ map { $sub->{'RULES'}[$_][0]{'ACTION'} } (0 .. $#{$lhs}) ];
    
            # Write out the alternate substitution rules
    		for $start (0 .. $#{$lhs})
    		{
    		    for (0 .. $#{$rhs->[$start]})
    		    {
    		        $LookupText .= "SUB GLYPH \"" . NameFromID($lhs->[$start]) . "\"\nWITH GLYPH \"" . NameFromID($rhs->[$start][$_]) . "\"\nEND_SUB\n";
    		    }
    		}
    	}
        else
		{
		    MyWarn "GSUB '$name' has unrecognized format $sub->{'FORMAT'}.\n" ;
		}
	}
	elsif ($l->{'TYPE'} == 4)
	{
		# n-1 (ligature) substitution

	    MyWarn ("Unexpected ACTION_TYPE '$sub->{'ACTION_TYPE'}' for lookup '$name'.\n") if $sub->{'ACTION_TYPE'} ne 'g';

		if ($sub->{'FORMAT'} == 1)
        {
    		# First pick up the coverage list:
    		$cover = [ CoverToList ($sub->{'COVERAGE'}) ];
    
    		# Now build $lhs & $rhs:
    		
    		$lhs = [];
    		$rhs = [];
    
    		for $i (0 .. $#{$cover})
    		{
    			# For each first glyph in the coverage, there can be multiple match strings, each corresponding to a ligature:
    			foreach $subrule (@{$sub->{'RULES'}[$i]})
    			{
    				# Make sure this is really a n-1 mapping:
    				die "GSUB '$name' has invalid ligature mapping" if $#{$subrule->{'ACTION'}} > 0;
    
    				push @{$lhs}, [ $cover->[$i], @{$subrule->{'MATCH'}} ];
    				push @{$rhs}, ($gid = $subrule->{'ACTION'}[0]);
    
    				$g = $GlyphFromID{$gid};
    
    				# Set the number of components for the ligature in the glyph definition:
    				# $g->{'COMPONENTS'} = 1 + ($#{$subrule->{'MATCH'}} + 1) if $g->{'TYPE'} == "LIGATURE";
    			}
    		}
    
    		# Write out the substitution rules:
    		# (very similar to type 2, except $rhs and $lhs are reversed)
    		$start = 0;
    		while ($start <= $#{$rhs})
    		{
    			($last, $col, $rhsGroup, $lhsGroup) = GetGroupRange(@{$rhs}, @{$lhs}, $start);
    			$LookupText .= "SUB " . join(" ", map {$_ == $col ? "GROUP \"$lhsGroup\"" : "GLYPH \"" . NameFromID($lhs->[$start][$_]). "\"" } (0 .. $#{$lhs->[$start]}) ) . "\n";
    			$LookupText .= "WITH " . ($last > $start ? "GROUP \"" . $rhsGroup : "GLYPH \"" . NameFromID($rhs->[$start])) . "\"\n";
    			$LookupText .= "END_SUB\n";
    			$start = $last+1;
    		}
    	}
    	else
		{
		    MyWarn "GSUB '$name' has unrecognized format $sub->{'FORMAT'}.\n" ;
		}

	}
	
}

##########################
#
# Process GSUB lookup
#
# Appends one or more lookup definitions to $LookupText

sub ProcessGSUBLookup ($)		# GSUB lookup index to process
{
	my $lid = shift;	# lookup index
	my $l= $gsub->{'LOOKUP'}[$lid];		# lookup structure

	my $nsubs = scalar (@{$l->{'SUB'}});    # Number of subtables	
 
	foreach my $subtbl (0 .. $nsubs-1)
    {
        my $name = $l->{'-name'};
        $name .= "\\$subtbl" if $nsubs > 1;
   		my $sub = $l->{'SUB'}[$subtbl];
    
    	if ($l->{'TYPE'} <= 4)
    	{
            WriteLookupHeader ($l, $name);
        	$LookupText .= "IN_CONTEXT\nEND_CONTEXT\nAS_SUBSTITUTION\n";
    		WriteSimpleGSUBLookup ($l, $name, $subtbl);
  			$LookupText .= "END_SUBSTITUTION\n";
    	}
    
    	elsif ($l->{'TYPE'} == 6)		# Chaining context
    	{

    	    MyWarn ("Unexpected ACTION_TYPE '$sub->{'ACTION_TYPE'}' for lookup '$name'.\n") if $sub->{'ACTION_TYPE'} ne 'l';
    		
    		# For now, just handling format 3:
    		if ($sub->{'FORMAT'} == 3)
            {
    		    # All the gruntwork has been done by CoalesceChainContextSubtables()
        
        		# TODO: It is possible that the type 6 lookup we are processing has a coverage (MATCH) that is smaller than that
        		# specified by the target lookup. I don't think VOLT would construct such a thing, but some other tool might.
        		# We really should pick up the MATCH string and pass it to WriteSimpleGSUBLookup to do some
        		# error checking of some sort.

        		# OK, now we can emit the lookup
        
                WriteLookupHeader ($l, $name);
                $LookupText .= $sub->{'-context'};
            	$LookupText .= "AS_SUBSTITUTION\n";
            	if (defined $sub->{'-lookupID'})
            	{
            	    WriteSimpleGSUBLookup ($gsub->{'LOOKUP'}[$sub->{'-lookupID'}], $name, 0);
            	}
            	else
            	{
            	    MyWarn "Undefined target lookup in GSUB lookup '$name'\n";
            	}
      			$LookupText .= "END_SUBSTITUTION\n";
      		}
	    	else
    		{
    		    MyWarn "GSUB '$name' has unhandled format $sub->{'FORMAT'}.\n" ;
    		}

        }
        else
        {
    	    MyWarn ("Unhandled GSUB lookup $name (type $l->{'TYPE'}) ignored for now.\n");
    	}
    }
}


##########################
# CacheAP
#
# take a list of base glyphs with anchors, and marks with anchors, and
# determine an attachment point name. Cache the data in case it is re-used
#

my @APs;   # Array of cached AP info. Each item in array is a hash containing:
#
#   'bases' a hash, indexed by glyphID, returning array, indexed by component, returning ref to anchor.
#   'marks' a hash, indexed by glyphID, returning ref to anchor


sub CacheAP(\%\%)
{
    my ($bases, $marks) = @_;
    
    my ($i, $gid, $apname);
    
    my $found = -1;  
    
    for $i (0 .. $#APs)
    {
        $found = $i;    # Assume this one will work
        
        # See if this AP is acceptable by comparing our bases and marks with the ones in this AP
        # Check bases first
        foreach $gid (keys %{$bases})
        {
            # If this gid isn't in the AP, then we're OK so far
            next unless exists $APs[$i]->{'bases'}{$gid};
            # This gid is in the AP -- verify the x & y matches:
            # In order to pass the test, base must have the same number of components and each component's AP must match
            my $APbase = $APs[$i]->{'bases'}{$gid};
            my $base = $bases->{$gid};
            if ($#{$APbase} != $#{$base})
            {   
                # Not the same number of components
                $found = -1;
            }
            else
            {
                # Verify each component's ap matches
                foreach (0 .. $#{$base})
                {
                    next if $APbase->[$_]{'x'} == $base->[$_]{'x'} && $APbase->[$_]{'y'} == $base->[$_]{'y'};
                    $found = -1;
                    last;           # No need to keep looking at other components in this base
                }
            }
            last if $found == -1;   # No need to keep looking at other gids in this AP
        }
        next if $found == -1;   # This AP no good -- try the next one
        # Now check marks
        foreach $gid (keys %{$marks})
        {
            # If this gid isn't in the AP, then we're OK so far
            next unless exists $APs[$i]->{'marks'}{$gid};
            # This gid is in the AP -- verify the x & y matches:
            next if $APs[$i]->{'marks'}{$gid}{'x'} == $marks->{$gid}{'x'} && $APs[$i]->{'marks'}{$gid}{'y'} == $marks->{$gid}{'y'};
            $found = -1;
            last;
        }
        
        # At this point, if $found is still undef, the we've found a usable AP. 
        # However, if it is -1 then we need to keep looking
        
        next if $found == -1;   # This AP no good -- try the next one

        # All the bases and marks are either absent or they match the ones in this AP -- therefore ths AP can be used!
        last;
        
    }
    
    unless ($found >= 0)
    {
        # Create new, empty, AP cache entry
        push @APs, { 'bases' => {}, 'marks' => {} };
        $found = $#APs;
    }
    
    $apname = "attach$found";
    
    # Add any missing glyphs to the cache:
    # Record info both in the APCache and in the glyph structure (for building Anchor definitions)
    foreach $gid (keys %{$bases})
    {
        next if exists $APs[$found]->{'bases'}{$gid};
        $APs[$found]->{'bases'}{$gid} = $GlyphFromID{$gid}{'ANCHORS'}{$apname} = $bases->{$gid} ;
    }
    foreach $gid (keys %{$marks})
    {
        next if exists $APs[$found]->{'marks'}{$gid};
        $APs[$found]->{'marks'}{$gid} = $GlyphFromID{$gid}{'ANCHORS'}{"MARK_$apname"} = $marks->{$gid}; 
    }

    return $apname;
}    

##########################
# ValueRecord
#
# Return a VOLT source string for a Font::TTF::GPOS value record
#

my %vrKeys = ( XAdvance => 'ADV', YPlacement => 'DY', XPlacement => 'DX');
my @vrUnprocessed = ( qw( YAdvance XPlaDevice YPlaDevice XAdvDevice YAdvDevice XIdPlacement YIdPlacement));

sub ValueRecord(\%)
{
    my $rec = shift;
    my $res = "POS";
    for (sort keys %vrKeys)
    {
        $res .= " $vrKeys{$_} $rec->{$_}" if exists $rec->{$_} && $rec->{$_} != 0;
    }
    $res .= " END_POS";

    foreach (@vrUnprocessed)
    {
        if (defined $rec->{$_})
        {
            MyWarn ("Unhandled ValueRecord data '$_'\n");
        }
    }
    
    $res;
}
        
##########################
# PairKern
#
# Returns a VOLT source string for the adjustment between two glyphs in a GPOS pairadjust (type 2) lookup of format 1
#
sub PairKern($$$)
{
    my ($sub, $first, $second) = @_;    # ref to sub table, first GID, second GID
    
    # Return it if already computed
    return $sub->{'PKcache'}{"$first.$second"} if exists $sub->{'PKcache'}{"$first.$second"};  
    
    my $res;
    
    # Find the rule, if it exists:
    
    if (exists $sub->{'COVERAGE'}{'val'}{$first})
    {
        my $rule = $sub->{'RULES'}[$sub->{'COVERAGE'}{'val'}{$first}];
        foreach my $subrule (@{$rule})
        {
            next unless $subrule->{'MATCH'}[0] == $second;
            # Found it!
            $res = ValueRecord(%{$subrule->{'ACTION'}[0]}) . ' ' . ValueRecord(%{$subrule->{'ACTION'}[1]});
            last;
        }
    }
    $res = undef if $res eq 'POS END_POS POS END_POS';  # All zero -- make as if this wasn't even present.
    $sub->{'PKcache'}{"$first.$second"} = $res;
}
        
        

##########################
# WriteSimplePOSLookup()
#
# Routine to append a simple GPOS lookup (types 1 - 6) subtable to $LookupText
#

sub WriteSimpleGPOSLookup ($$$)		# lookup structure reference, name to be used in lookup, subtable index
{
	my ($l, $name, $stbl) = @_;

	my ($lhs, $rhs, $start, $last, $col, $lhsGroup, $rhsGroup);
	my (@cover, $gid, $i, $subrule);
	
	my $sub = $l->{'SUB'}[$stbl];

	if ($l->{'TYPE'} == 1)
	{
	    # Single adjustment

	    MyWarn ("Unexpected ACTION_TYPE '$sub->{'ACTION_TYPE'}' for lookup '$name'.\n") if $sub->{'ACTION_TYPE'} !~ /[ov]/;

	    
		@cover = CoverToList ($sub->{'COVERAGE'}) ;
		
		
		if ($sub->{'FORMAT'} == 1)
		{
		    # Format 1 -- a single value record for entire group.
		    
    		$LookupText .= "ADJUST_SINGLE " . GlyphOrGroup(@cover) . " BY " . ValueRecord(%{$sub->{'ADJUST'}}) . "\nEND_ADJUST\n";
    	}
    	elsif ($sub->{'FORMAT'} == 2)
    	{
    	    # Format 2 -- value record for each covered glyph.
    	    $LookupText .= "ADJUST_SINGLE\n";
    	    
    	    foreach (0 .. $#cover)
    	    {
    	        $LookupText .= " GLYPH \"" . NameFromID($cover[$_]) . "\" BY " . ValueRecord(%{$sub->{'RULES'}[$_][0]{'ACTION'}[0]}) . "\n";
    	    }
    	    $LookupText .= "END_ADJUST\n";
    	}
    	else
        {
		    MyWarn "GPOS '$name' has unrecognized format $sub->{'FORMAT'}.\n"; 
		}
	}
	elsif ($l->{'TYPE'} == 2)
	{
	    # Pair adjustment

	    MyWarn ("Unexpected ACTION_TYPE '$sub->{'ACTION_TYPE'}' for lookup '$name'.\n") if $sub->{'ACTION_TYPE'} != 'p';

		$LookupText .= "ADJUST_PAIR\n";

        if ($sub->{'FORMAT'} == 1)
        {
    		# Format 1 -- glyph-pair value records. 
    		
    		# This is a complicated one because I want to coalesce glyphs into groups. I do this by examining every
    		# pair of first glyphs and checking their adjustment with all 2nd glyphs -- if these adjustments are
    		# all the same then the two first glyphs can be grouped together. Similarly for every pair of 2nd 
    		# glyphs (examine the adjustment with all possible first glyphs).
    		
		    my ($i, $j, $k);  
		    

    		# First step is to get a complete list of 1st and 2nd glyphs:
    		
    		my @first = CoverToList($sub->{'COVERAGE'});
    		my %second;
		    foreach $i (@{$sub->{'RULES'}})
		    {
		        foreach $j (@{$i})
		        {
		            $second{$j->{'MATCH'}[0]} = 1;
		        }
		    }
		    my @second = sort {$a <=> $b} keys %second;
		    
		    # OK, the fun begins
		    my (@g1, @g2);  # record of the results. These arrays parallel @first and @second, and contain:
		    #   undef -- this glyph hasn't matched anything yet.
		    #   scalar -- index of a (prior) glyph with which this one can be grouped
		    #   array -- list of indicies of (subsequent) glyphs which are grouped with this one.
		    
		    # First examine every pair of 1st glyphs to see if they can coalesce
		    for $i (0 .. $#first)
		    {
		        next if defined $g1[$i];
		        # Initialize array in case we get any that can coalesce with it
		        $g1[$i] = [ $i ];
		        for $j ($i+1 .. $#first)
		        {
		            next if defined $g1[$j];
		            # for first glyphs at $i1 and $j1, compare adjustment with all 2nd glyphs
		            my $match = 1;  # assume they all match
		            for $k (0 .. $#second)
		            {
		                if (PairKern($sub, $first[$i], $second[$k]) ne PairKern($sub, $first[$j], $second[$k]))
		                {
		                    $match = 0; #fail
		                    last;
		                }
		            }
		            next unless $match;
		            # Found a match! We can coalesce First glyphs indexed by $i and $j
		            push @{$g1[$i]}, $j;
		            $g1[$j] = $i;
		        }
		    }
		    # Make sure groups are big enough to use:
		    if (defined $opt_g)
		    {
		        for $i (0 .. $#first)
		        {
		            next unless ref($g1[$i]) eq 'ARRAY';
		            next if scalar(@{$g1[$i]}) >= $opt_g;   # This is a keeper
		            next if scalar(@{$g1[$i]}) == 1;        # This is already a singleton -- leave it.
		            # Group is too small -- destroy it:
		            foreach $j (@{$g1[$i]})
		            {
		                $g1[$j] = [ $j ];
		            }
		        }
		    }
		    
		    # Now repeat the logic on the every pair of 2nd glyphs
		    for $i (0 .. $#second)
		    {
		        next if defined $g2[$i];
		        # Initialize array in case we get any that can coalesce with it
		        $g2[$i] = [ $i ];
		        for $j ($i+1 .. $#second)
		        {
		            next if defined $g2[$j];
		            # for second glyphs at $i1 and $j1, compare adjustment with all first glyphs
		            my $match = 1;  # assume they all match
		            for $k (0 .. $#first)
		            {
		                if (PairKern($sub, $first[$k], $second[$i]) ne PairKern($sub, $first[$k], $second[$j]))
		                {
		                    $match = 0; #fail
		                    last;
		                }
		            }
		            next unless $match;
		            # Found a match! We can coalesce Second glyphs indexed by $i and $j
		            push @{$g2[$i]}, $j;
		            $g2[$j] = $i;
		        }
		    }
		    # Make sure groups are big enough to use:
		    if (defined $opt_g)
		    {
		        for $i (0 .. $#second)
		        {
		            next unless ref($g2[$i]) eq 'ARRAY';
		            next if scalar(@{$g2[$i]}) >= $opt_g;   # This is a keeper
		            next if scalar(@{$g2[$i]}) == 1;        # This is already a singleton -- leave it.
		            # Group is too small -- destroy it:
		            foreach $j (@{$g2[$i]})
		            {
		                $g2[$j] = [ $j ];
		            }
		        }
		    }
		    
		    # Whew!  Now build the lookup
		    map { $LookupText .= ' FIRST ' . GlyphOrGroup(@first[@{$_}]); } grep {ref($_) eq 'ARRAY'} @g1;
		    $LookupText .= "\n";
		    map { $LookupText .= ' SECOND ' . GlyphOrGroup(@second[@{$_}]); } grep {ref($_) eq 'ARRAY'} @g2;
		    $LookupText .= "\n";
		    
		    $i = 1;
		    for my $f (0 .. $#first)
		    {
		        next unless ref($g1[$f]) eq 'ARRAY';
		        $j = 1;
    		    for my $s (0 .. $#second)
    		    {
    		        next unless ref($g2[$s]) eq 'ARRAY';
    		        my $res = PairKern($sub, $first[$g1[$f][0]], $second[$g2[$s][0]]);
    		        $LookupText .= " $i $j BY $res\n" if defined $res;
    		        $j++;
    		    }
    		    $i++;
		    }
		
	    }
	    elsif ($sub->{'FORMAT'} == 2)
		{
    		# Format 2 -- class-based value records
    		
    		my @first = map { $#{$_} >= 0 ? ' FIRST ' . GlyphOrGroup(@{$_}) : undef } ClassToLists ($sub->{'CLASS'});
    		my @second = map { $#{$_} >= 0 ? ' SECOND ' . GlyphOrGroup(@{$_}) : undef } ClassToLists ($sub->{'MATCH'}[0]);
    		
    		$LookupText .= join('', @first) . "\n";
    		$LookupText .= join('', @second) . "\n";
    		my $i = 1;
    		foreach my $f (0 .. $#first)
    		{
                next unless defined $first[$f];
                my $j = 1;
                foreach my $s (0 .. $#second)
                {
                    next unless defined $second[$s];
                    $LookupText .= " $i $j BY " . ValueRecord(%{$sub->{'RULES'}[$f][$s]{'ACTION'}[0]}) . ' ' . ValueRecord(%{$sub->{'RULES'}[$f][$s]{'ACTION'}[1]}) . "\n";
                    $j++;
                }
                $i++;
            }
        }
        else
        {
		    MyWarn "GPOS '$name' has unrecognized format $sub->{'FORMAT'}.\n"; 
		}

        $LookupText .= "\nEND_ADJUST\n";	

	}
	elsif ($l->{'TYPE'} == 3)
	{
	    # Cursive Attachment

	    MyWarn ("Unexpected ACTION_TYPE '$sub->{'ACTION_TYPE'}' for lookup '$name'.\n") if $sub->{'ACTION_TYPE'} ne 'e';
	    
		if ($sub->{'FORMAT'} == 1)
		{
    		# First pick up the coverage list:
    		@cover = CoverToList ($sub->{'COVERAGE'}) ;
    		
    		# Initialize hashes to keep track of GIDs with entry/exit points
    		$lhsGroup = {};
    		$rhsGroup = {};
    		
    		# Pick out anchor definitions, building left-hand and right-hand lists of glyphs
    		foreach my $gid (@cover)
    		{
    		    my $action = $sub->{'RULES'}[$sub->{'COVERAGE'}{'val'}{$gid}][0]{'ACTION'};
    		    
    		    for $i (0 .. 1)
    		    {
    		        next unless $action->[$i];
    		        # Entry or exit defined:
    		        my $which = (qw(entry exit))[$i];
    		        $GlyphFromID{$gid}->{'ANCHORS'}{$which} = $action->[$i];      # ref to anchor -- we'll parse this apart later
    		        ($i == 0 ? $rhsGroup : $lhsGroup)->{$gid} = 1;    # Build lhs & rhs groups
    		    }
    		}
    		$LookupText .= "ATTACH_CURSIVE\n";
    		$LookupText .= "EXIT  " . GlyphOrGroup(keys %{$lhsGroup}) . "\n";
    		$LookupText .= "ENTER  " . GlyphOrGroup(keys %{$rhsGroup}) . "\n";
    		$LookupText .= "END_ATTACH\n";
    	}
    	else
		{
		    MyWarn "GPOS '$name' has unrecognized format $sub->{'FORMAT'}.\n"; 
		}
    	
    }
    elsif ($l->{'TYPE'} == 4 || $l->{'TYPE'} == 5 || $l->{'TYPE'} == 6)
    {
        # Mark-to-Base and Mark-to-Mark (identical in structure)
        
        my (@marks, @bases);    # Indexed by markclass
        
        my ($class, $anchor, $rules, $component);

	    MyWarn ("Unexpected ACTION_TYPE '$sub->{'ACTION_TYPE'}' for lookup '$name'.\n") if $sub->{'ACTION_TYPE'} ne 'a';
	    
		if ($sub->{'FORMAT'} == 1)
        {
    	    foreach $gid (keys %{$sub->{'MATCH'}[0]{'val'}})
    	    {
    	        ($class, $anchor) = @{$sub->{'MARKS'}[$sub->{'MATCH'}[0]{'val'}{$gid}]};
    	        $marks[$class]{$gid} = $anchor;
    	    }
    	    
    	    # Programmer note: indexing scheme for RULES is:
    	    #   $sub->{'RULES'}[Base_char_index][Ligature_component]{'ACTION'}[Mark_class]
    	    
    	    foreach $gid (keys %{$sub->{'COVERAGE'}{'val'}})
    	    {
    	        my $rules = $sub->{'RULES'}[ $sub->{'COVERAGE'}{'val'}{$gid} ];
    	        if ($#{$rules} > 0)
    	        {
    	            # Real ligature -- let's make sure glyph data knows how many components
    	            MyWarn "Lookup $name defines different number of components for ligature glyph $gid.\n" 
    	                if exists $GlyphFromID{$gid}->{'COMPONENTS'} and $GlyphFromID{$gid}->{'COMPONENTS'} != $#{$rules} + 1;
    	            $GlyphFromID{$gid}->{'COMPONENTS'} = $#{$rules} + 1 ;
    	        }
    	        foreach $component (0 .. $#{$rules})
    	        {
                    $class = 0;
                    foreach $anchor (@{$sub->{'RULES'}[ $sub->{'COVERAGE'}{'val'}{$gid} ][$component]{'ACTION'}})
                    {
                        $bases[$class]{$gid}[$component] = $anchor if defined $anchor;    
                        $class++;
                    }
    	        }
    	    }
    	    
       		$LookupText .= "ATTACH " . GlyphOrGroup(keys %{$sub->{'COVERAGE'}{'val'}}) . "\nTO";
    	    
    	    for $class (0 .. $#marks)
    	    {
    	        next unless scalar(keys %{$marks[$class]});  # ignore any mark classes that have no elements
    	        my $APname = CacheAP(%{$bases[$class]}, %{$marks[$class]});
        		$LookupText .= " " . GlyphOrGroup(keys %{$marks[$class]}) . " AT ANCHOR \"$APname\"";
    	    }    
       		$LookupText .= "\nEND_ATTACH\n";
       	}
       	else
		{
		    MyWarn "GPOS '$name' has unrecognized format $sub->{'FORMAT'}.\n"; 
		}

    
    
    }
	else
	{
	    MyWarn ("Unhandled GPOS lookup $name (type $l->{'TYPE'}) ignored for now.\n");
	}
}



##########################
#
# Process GPOS lookup
#
# Appends one or more lookup definitions to $LookupText

sub ProcessGPOSLookup ($)		# GPOS lookup index to process
{
	my $lid = shift;	# lookup index
	my $l= $gpos->{'LOOKUP'}[$lid];		# lookup structure
	
	
	my $nsubs = scalar (@{$l->{'SUB'}});    # Number of subtables
 
	foreach my $subtbl (0 .. $nsubs-1)
    {
        my $name = $l->{'-name'};
        $name .= "\\$subtbl" if $nsubs > 1;
    
    	if ($l->{'TYPE'} <= 6)
    	{
            WriteLookupHeader ($l, $name);
        	$LookupText .= "IN_CONTEXT\nEND_CONTEXT\nAS_POSITION\n";
    		WriteSimpleGPOSLookup ($l, $name, $subtbl);
  			$LookupText .= "END_POSITION\n";
    	}
    	elsif ($l->{'TYPE'} == 8)		# Chaining context
    	{
    		my $sub = $l->{'SUB'}[$subtbl];
    		
    		# This is just like GSUB:
    		if ($sub->{'FORMAT'} == 3)
    		{
    		    # All the gruntwork has been done by CoalesceChainContextSubtables()
        
        		# TODO: It is possible that the type 6 lookup we are processing has a coverage (MATCH) that is smaller than that
        		# specified by the target lookup. I don't think VOLT would construct such a thing, but some other tool might.
        		# We really should pick up the MATCH string and pass it to WriteSimpleLookup to do some
        		# error checking of some sort.
        
        		# OK, now we can emit the lookup
        
                WriteLookupHeader ($l, $name);
            	$LookupText .= $sub->{'-context'};
            	$LookupText .= "AS_POSITION\n";
            	if (defined $sub->{'-lookupID'})
            	{
            	    WriteSimpleGPOSLookup ($gpos->{'LOOKUP'}[$sub->{'-lookupID'}], $name, 0);
            	}
            	else
            	{
            	    MyWarn "Undefined target lookup in GSUB lookup '$name'\n";
            	}
      			$LookupText .= "END_POSITION\n";
      		}
      		else
        	{
		        MyWarn "GPOS '$name' has unhandled format $sub->{'FORMAT'}.\n"; 
		    }  
        }
        else
        {
    	    MyWarn ("Unhandled GPOS Lookup type " . $l->{'TYPE'} . " ignored for now.\n");
    	}
    }
}



##########################
#
# Generate the script, lang, and feature source. 
# This also tells us which lookups need to be directly processed.
#

my ($s, $l, $f);    # Script, Lang, and Feature

# Record which lookups needed within gsub and gpos
$gsub->{'-LookupsNeeded'} = []; 
$gpos->{'-LookupsNeeded'} = [];


# Note: VOLT co-mingles script/lang/feature trees from GPOS and GDEF.
# This code attempts to keep script, lang, and feature lists sorted by tag, though this isn't essential for VOLT

# Compile a list of scripts, then iterate over them
my %scripts;
map {$scripts{$_} = 1} (keys %{$gsub->{'SCRIPTS'}}) if $gsub;
map {$scripts{$_} = 1} (keys %{$gpos->{'SCRIPTS'}}) if $gpos;
foreach $s (sort keys %scripts)
{
	$SLFText .= "DEF_SCRIPT ";
	$SLFText .= "NAME \"$ttnames{'SCRIPT'}{$s}\" " if defined $ttnames{'SCRIPT'}{$s};
	$SLFText .= "TAG \"$s\"\n\n";

    # For this script, compile list of languages and then iterate over them
    my %langs;
    map {$langs{$_} = 1} (@{$gsub->{'SCRIPTS'}{$s}{'LANG_TAGS'}}) if $gsub;
    map {$langs{$_} = 1} (@{$gpos->{'SCRIPTS'}{$s}{'LANG_TAGS'}}) if $gpos;
    foreach $l ('DEFAULT', sort keys %langs)
	{
	    # Some fonts, e.g., Doulos, have a default language *and* have a 'dflt' language, one referring to the other. Skip one if so:
		next if ($l eq 'DEFAULT' || $l eq 'dflt') && (exists $gsub->{'SCRIPTS'}{$s}{$l}{' REFTAG'} || exists $gpos->{'SCRIPTS'}{$s}{$l}{' REFTAG'});
		
		$SLFText .= "DEF_LANGSYS ";
		if ($l eq 'DEFAULT')
		{
			$SLFText .= "NAME \"Default\" TAG \"dflt\"\n\n";
		}
		else
		{
			$SLFText .= "NAME \"$ttnames{'LANGUAGE'}{$l}\" " if defined $ttnames{'LANGUAGE'}{$l};
			$SLFText .= "TAG \"$l\"\n\n";
		}

		MyWarn ("VOLT doesn't understand default GSUB feature; setting ignored ($s/$l).\n") if ($gsub && $gsub->{'SCRIPTS'}{$s}{$l}{'DEFAULT'} != 65535);
		MyWarn ("VOLT doesn't understand default GPOS feature; setting ignored ($s/$l).\n") if ($gpos && $gpos->{'SCRIPTS'}{$s}{$l}{'DEFAULT'} != 65535);

        # For this script and language, compile list of features and iterate over them
        
        # Note: there can be multiple instances of any given feature (e.g., "ccmp" then "ccmp _1", etc.)
        # because the same feature tag can be (probably is) present under each language. However, VOLT
        # knows them all as simply the 4 character tag (e.g., "ccmp")
        
        my %feats;
        # It is possible, but not likely, that we'll have a feature implemented by both gsub and gpos lookups.
        # Therefore we use a slightly different technique than above to record what features are needed:
        map {$feats{substr($_,0,4)} .= "|S$_" } (@{$gsub->{'SCRIPTS'}{$s}{$l}{'FEATURES'}} ) if $gsub;
        map {$feats{substr($_,0,4)} .= "|P$_"} (@{$gpos->{'SCRIPTS'}{$s}{$l}{'FEATURES'}} ) if $gpos;
        foreach $f (sort keys %feats)
		{
			$SLFText .= "DEF_FEATURE ";
			$SLFText .= "NAME \"$ttnames{'FEATURE'}{$f}\" " if defined $ttnames{'FEATURE'}{$f};
			$SLFText .= "TAG \"$f\"\n";
			
			foreach ( $feats{$f} =~ /\|([^|]+)/g)
			{
			    my ($which, $actualfeat) = ($_ =~ /^(.)(.*)$/);
			    # At this point $which is either 'S' or 'P' (for gsub or gpos), and 
			    # $actualfeat is the full feature name, e.g., "ccmp _1".
			    
			    my $tbl = ($which eq 'S' ? $gsub : $gpos);
			    foreach my $lid (@{$tbl->{'FEATURES'}{$actualfeat}{'LOOKUPS'}})
			    {
                    unless ($tbl->{'-LookupsNeeded'}[$lid])
                    {
                        # One time processing for this lookup:
                        
    			        # Make sure we remember to include this one in DEF_LOOKUPs:
    			        $tbl->{'-LookupsNeeded'}[$lid] = 1;
    			        
    			        # Give it a name:
    			        $tbl->{'LOOKUP'}[$lid]{'-name'} = "$f" . "_$which$lid";
    			        
    			        # If this is a chaining context lookup, we need to coalesce subtables.
    			        CoalesceChainContextSubtables ($tbl->{'LOOKUP'}[$lid],$tbl) if $tbl->{'LOOKUP'}[$lid]{'TYPE'} == ($which eq 'S' ? 6 : 8);
    			    }
   			        my $nsubs = scalar (@{$tbl->{'LOOKUP'}[$lid]{'SUB'}});    # Number of subtables
   			        my $lname = $tbl->{'LOOKUP'}[$lid]{'-name'};
			        foreach (0 .. $nsubs-1)
			        {
			            $SLFText .= " LOOKUP \"$lname" . ($nsubs > 1 ? "\\$_" : '') . "\"";
			        }
			    }
			    
			}

			$SLFText .= "\nEND_FEATURE\n";
		}
		$SLFText .= "END_LANGSYS\n";
	}
	$SLFText .= "END_SCRIPT\n";
}


# Now we know what lookups we need to process, let's do it:
foreach my $i (0 .. $#{$gsub->{'-LookupsNeeded'}})
{
    ProcessGSUBLookup $i if $gsub->{'-LookupsNeeded'}[$i];
}
    
foreach my $i (0 .. $#{$gpos->{'-LookupsNeeded'}})
{
    ProcessGPOSLookup $i if $gpos->{'-LookupsNeeded'}[$i];
}


# OK, now we can collect everything together

my $vtp;

# print GLYPH definitions:
foreach $gid (sort {$a <=> $b} keys %GlyphFromID)
{
	$g = $GlyphFromID{$gid};
	$vtp .= "DEF_GLYPH \"" . NameFromID($gid) . "\" ID $gid";

	if (exists $g->{'@UNICODES'}) {
		# If array contains exactly one value, output UNICODE in gdef, else must output UNICODEVALUES
		if (scalar (@{$g->{'@UNICODES'}}) == 1) {
			$vtp .= sprintf (" UNICODE %d", $g->{'@UNICODES'}[0]);
		} else {
			$vtp .= sprintf (" UNICODEVALUES \"%s\"", join (",", map {sprintf "U+%04X", $_} @{$g->{'@UNICODES'}}));
		}
	}

	$vtp .= " TYPE " . (exists $g->{'TYPE'} ? $g->{'TYPE'} : "BASE");
	if ($g->{'TYPE'} eq "LIGATURE")
	{
		if (exists $g->{'COMPONENTS'})
		{
			$vtp .= " COMPONENTS $g->{'COMPONENTS'}" ;
		}
		else
		{
			MyWarn ("Glyph $gid is a ligature, but I don't know how many components it has.\n");
		}
	}

	$vtp .= " END_GLYPH\n";

}

# print Script/Language/Features:
$vtp .=  $SLFText;

# print  GROUP definitions:
foreach $g (GetGroupNames)
{
	$vtp .= "DEF_GROUP \"$g\"\n ENUM";
	map {$vtp .= " GLYPH \"$GlyphFromID{$_}->{'NAME'}\"" } GetGroup($g);
	$vtp .= " END_ENUM\nEND_GROUP\n";
}

# print lookups:
$vtp .= $LookupText;

# print anchors
foreach $gid (sort {$a <=> $b} keys %GlyphFromID)
{
    my $g = $GlyphFromID{$gid};
    
    foreach my $apname (sort keys %{$g->{'ANCHORS'}})
    {
        my ($anchors, $component);
        
        if (ref $g->{'ANCHORS'}{$apname} eq 'ARRAY')
        {   $anchors = $g->{'ANCHORS'}{$apname}; }
        else
        {   $anchors = [ $g->{'ANCHORS'}{$apname} ];}
        
        for $component (1 .. $#{$anchors}+1)
        {
            my $anchor = $anchors->[$component-1];
            for (qw(xid yid p xdev ydev))
            {
                MyWarn "Glyph anchor field '$_' not implemented -- being ignored.\n" if exists $anchor->{$_};
            }
            $vtp .= "DEF_ANCHOR \"$apname\" ON $gid GLYPH ". NameFromID($gid) . " COMPONENT $component LOCKED AT POS DX $anchor->{'x'} DY $anchor->{'y'} END_POS END_ANCHOR\n";
        }
    }
}

# print PPM text:
$vtp .= "GRID_PPEM 20\nPRESENTATION_PPEM 72\nPPOSITIONING_PPEM 144";

# print cmap info:
foreach (sort { $a->{'Platform'} <=> $b->{'Platform'} } @{$font->{'cmap'}{'Tables'}})
{
	$vtp .= "\nCMAP_FORMAT $_->{'Platform'} $_->{'Encoding'} $_->{'Format'} ";
}
$vtp .= "END\n";


# Write out results

if (defined $ARGV[1])
{
    # Write out new font:
    
    # Insert the replacement source into the font
    # Create, if it doesn't exist, the VOLT source table we are going to insert
    $font->{'TSIV'} = Font::TTF::Table->new (PARENT => $font, NAME => 'TSIV') unless exists $font->{'TSIV'};
    
    # Replace source:
    $font->{'TSIV'}->{' dat'} = $vtp;
    
    # Remove other VOLT tables if they exist:
    for (qw( TSID TSIP TSIS )) { delete $font->{$_} };
    
    unless ($opt_r)
    {
    	# Remove compiled tables if they exist:
    	for (qw( GDEF GPOS GSUB)) { delete $font->{$_} };
    }
    
    $font->out($ARGV[1]);
}

if (defined $opt_v)
{
	# Open output source file:
	open (OUT, ">$opt_v") or die "Couldn't open '$opt_v' for writing.";
	print OUT $vtp;
	close OUT;
}

my $xx;
$xx = "\nFINISHED. ";
$xx .= ($warningCount > 0 ? $warningCount : "No") . " warning" . ($warningCount == 1 ? '' : 's') . " issued. ";
$xx .= ($genericCount > 0 ? $genericCount : "No") . " unnamed glyph" . ($genericCount == 1 ? '' : 's') . " used. \n\n";
if ($opt_l)
{
    print LOG $xx;
    close LOG;
}
print STDERR $xx;

#])}