Font::TTF::Scripts::AP - Memory representation of a L<TTFBuilder|bin::TTFBuilder> Attachment Point database (APDB)

Font-TTF-Scripts documentation Contained in the Font-TTF-Scripts distribution.

Index

Code Index:

NAME

Top

Font::TTF::Scripts::AP - Memory representation of a TTFBuilder (bin::TTFBuilder) Attachment Point database (APDB)

SYNOPSIS

Top

 use Font::TTF::Scripts::AP;
 $ap = Font::TTF::Scripts::AP->read_font($ttf_file, $ap_file, %opts);
 $ap->make_classes();

INSTANCE VARIABLES

Top

cmap

Reference to the Microsoft cmap (Font::TTF::cmap) within the font.

font

Reference to a font structure. read_font will cause at least the post, cmap, loca, and name tables to be read in.

glyphs

An array of references to glyph data structures, indexed by glyphID. Stucture elements are:

uni

Array of Unicode scalar values (decimal integers), if any, that map from cmap to this glyph.

gnum

Actual glyph ID from font.

post

Actual Postscript name from font.

name

This element is set by "make_names" or "make_classes" and is the replacement name returned by "make_name".

Note: The uni, gnum and post values are based on the UID, GID, and PSName fields of the APDB. If there are descrepancies between the APDB and the font's internal tables, then for calcuating the above three values, priority is given first to UID field, then PSName field, and finally GID.

glyph

Reference to glyph structure read from font.

line

Line number in APDB where glyph is defined.

points

A hash of references to attachment point structures for this glyph, keyed by attachment point type (aka name). Each AP structure contains

name

The name (type in TTFBuilder terminology) of the attachment point

x, y

X and Y coordinates for the attachment point

line

Line number in APDB where this point is defined.

components

Present if the glyph is a composite. Is a reference to an array of component structures. Each component structure includes:

bbox

comma separated list of bounding box coordinates, i.e., x1, y1, x2, y2

uni

Unicode scalar value, if any, of the component. (decimal integer)

line

Line number in APDB where this component is defined.

Note: The following instance variables contain the actual text read from the APDB. If there are descrepancies between the APDB and the font, these values may differ from corresponding values given above. Therefore these values should not be used except for diagnostic purposes.

UID

Unicode scalar value, if any, as specified in the APDB. (string of hex digits)

PSName

Postscript name, if any, as specified in the APDB

GID

Glyph id, if any, as specified in the APDB

classes

Created by "make_classes", this is a hash keyed by class name returning an array of GIDs for glyphs that are in the class. Classes are identified by extensions (part after a '.') on the post name of each glyph. For each such extension, two classes are defined. The first is the class of all glyphs that have that extension (class name is the extension). The second is the class of nominal glyphs corresponding to the glyphs with that extension (class name is the extension but with the prefix 'no_').

lists

Created by "make_classes", this is a hash keyed by attachment point name (as modified by "make_point") returning an array of GIDs for glyphs that have the given attachment point.

vecs

If defined, this variable will be updated by "make_classes". It is a hash, keyed by attachment point name (as modified by "make_point") returning a bit vec bit array, indexed by GID, each bit set to 1 if the corresponding glyph has the given attachment point.

ligclasses

Optionally created by "make_classes" if ligatures are requested and they exist. The base forms class is no_code while the ligatures are held in code.

WARNINGS

If -errorfh not set, this accumulates any warning or error messages encountered.

cWARNINGS

Count of number fo warnings or errors encountered.

METHODS

Top

$ap = Font::TTF::Scripts::AP->read_font ($ttf_file, $ap_file, %opts)

Reads the TrueType font file $ttf_file and the attachment point database (APDB) file $ap_file, and builds a structure to represent the APDB.

Options that may be supplied throught the %opts hash include:

-omittedAPs

A list of attachment point types to ignore. Can be a string containing comma- or space-separated names, or a ref to an array of strings.

-strictap

If true, warn about attachment points that do not correspond to appropriate points on the outline of the glyph.

-knownemptyglyphs

If this option is specified, read_font will warn if glyphs that should have outlines don't. The option value should be a list of names of glyphs that are known to have no outline (thus shouldn't generate warning). Can be a string containing comma- or space-separated names, or a ref to an array of strings.

-errorfh

A file handle to which warning messages are to be printed. If not supplied, warning messages are accumulated in WARNINGS.

$ap->make_names

An alternative to "make_classes", this method just creates name records for all the glyphs in the font. That is, for every glyph record in glyphs, "make_names" invokes "make_name" and saves the result in the glyph' sname element.

$ap->make_classes (%opts)

First, for every glyph record in glyphs, make_classes invokes make_name followed by, for every attachment point record in points, make_point . This gives sub-classes a chance to convert the names (of glyphs and points) to an alternate form (e.g., as might be useful in building Graphite source.) See GDL.pm (Font::TTF::Scripts::GDL) for an example.

make_classes then builds the classes and lists instance variables, and updates the vecs instance variable (if it is defined).

Options supported are:

-ligatures

Takes two values: first or last. First creates ligature classes with the class based on the first element of the ligature and the contents of the class on the rest of the ligature. Last creates classes based on the last element of the ligature, thus grouping all glyphs with the same last ligature element together. Ligature classes are stored in $self-{'ligclasses'}>.

Ligature elements are separated by _ in the glyph name. Ligatures are only made if there are corresponding non ligature glyphs in the font. A final .text on the glyph name of a ligature is assumed to be associated with the whole ligature and not just the last element.

$ap->make_name ($gname, $uni, $glyph)

Given a glyph's name, USV, and a reference to its glyph structure, returns a replacement name, e.g., one that might be an acceptable identifier in a programming language. By default this returns $gname, but the function could be overridden when subclassing.

$ap->make_point ($pname, $glyph)

Given an an attachment point name and a reference to its glyph structure, returns a replacement name, e.g., one that might be an acceptable identifier in a programming language, or undef to indicate the attachment point should be omitted. By default this returns $pname, but the function could be overridden when subclassing.

$fv->align_glyphs($dat)

Provides one possible way to map glyph names in a new font with an existing project.

Compares the list of glyphs found during "read_font" (the new glyph list) with the list from "parse_volt" in $dat (the old glyph list>, returning an array that provides a mapping between old and new glyph IDs. The array is indexed by old glyph ID and returns the new glyph ID.

This implementation works by sdiffing the two ordered lists of glyph names and then matching them up, first by name then by uni.

$str = $ap->as_xml()

Returns an XML representation of the AP database

See also

Top

TTFBuilder (bin::TTFBuilder), Font::TTF::Font

Font-TTF-Scripts documentation Contained in the Font-TTF-Scripts distribution. 
package Font::TTF::Scripts::AP;


use Font::TTF::Font 0.36;
use XML::Parser::Expat;
use Algorithm::Diff qw(sdiff);

use strict;
use vars qw($VERSION);

$VERSION = "0.09";  # MH  Add classes property support
# $VERSION = "0.08";  # BH	Generalize values for %opts so can be space- or comma-separated list in a scalar, or can be an array ref.
# $VERSION = "0.07";  # MH    add make_names if you don't want make_classes
# $VERSION = "0.06";  # MH    debug glyph alternates for ligature creation, add Unicode
# $VERSION = "0.05";  # MH    add glyph alternates e.g. A/u0410 and ligature class creation
# $VERSION = "0.04";	# BH   in progress
# Merged my AP.pm with MH's version:
#	Rename _error() to error()
#	Added -errorfh support
#	Removed 'gunis' and 'gnames' (similar functions available from the font)
#	Added make_classes method

#$VERSION = "0.03";	# BH   2004-02-02
#	Fix to process AP data even when there is no glyph outline (e.g., on space)

#$VERSION = "0.02";	# BH   2003-09-22	Added 'components' array
					#					No longer ignores blank glyphs (those with no outline)
#$VERSION = "0.01"; # BH   2003-01-06   Original extracted from GDL.PM
					#					New functionality: support for -omittedAPs option giving a comma-separated
					#					list of attachment points to be ignored.



sub read_font
{
    my ($class, $fname, $xml_file, %opts) = @_;
    my (@glyphs, $f, $t, $xml, $cur_glyph, $cur_pt, $numg, @reverse);
    my ($self) = {};
    bless $self, ref $class || $class;

    my (%omittedAPs, %known_empty_glyphs);
    map {$omittedAPs{$_} = 1} ( ref ($opts{'-omittedAPs'}) eq 'ARRAY' ? @{$opts{'-omittedAPs'}} : ($opts{'-omittedAPs'} =~m/[^\s,]+/go));
    map {$omittedAPs{"_$_"} = 1} grep {/^[^_]/} keys %omittedAPs;
    map {$known_empty_glyphs{$_} = 1} ( ref ($opts{'-knownemptyglyphs'}) eq 'ARRAY' ? @{$opts{'-knownemptyglyphs'}} : ($opts{'-knownemptyglyphs'} =~m/[^\s,]+/go));

    if ($fname)
    {
        $f = Font::TTF::Font->open($fname) || die "Can't open font $fname";
        foreach $t (qw(post cmap loca name))
        { $f->{$t}->read; }

        $self->{'font'} = $f;
        $self->{'cmap'} = $f->{'cmap'}->find_ms->{'val'} || die "Can't find Unicode table in font $fname";
        @reverse = $f->{'cmap'}->reverse('array' => 1);
        $numg = $f->{'maxp'}{'numGlyphs'};
    }

    
#    my $minUID;
#    if (exists $f->{'OS/2'})
#    {
#    		my $os2 = $f->{'OS/2'}->read || die "Can't read OS/2 table in font $fname";
#    		$minUID = $os2->{'usFirstCharIndex'};
#    }
#	printf STDERR "FirstCharIndex = U+%04X\n", $minUID;

    $xml = XML::Parser::Expat->new();
    $xml->setHandlers('Start' => sub {
        my ($xml, $tag, %attrs) = @_;

        if ($tag eq 'font')
        {
            foreach (qw(name upem))
            { $self->{$_} = $attrs{$_}; }
        }
        elsif ($tag eq 'glyph')
        {
            my ($ug, $pg, $ig);
            $cur_glyph = {%attrs};
            undef $cur_pt;

            if ($f && defined $attrs{'UID'})
            {
                $attrs{'UID'} =~ s/^U\+//o;      # Not supposed to contain "U+", but some do
                my ($uni) = hex($attrs{'UID'});
                $ug = $self->{'cmap'}{$uni};
                if (defined $ug)
                { $cur_glyph->{'gnum'} = $ug; }
                else
                { $self->APerror($xml, $cur_glyph, undef, "No glyph associated with UID $attrs{'UID'}"); }
                $cur_glyph->{'uni'} = [$uni];
                # delete $attrs{'UID'};  # Added in MH's version; v0.04: now believed un-needed and un-wanted.
            }
            if ($f && defined $attrs{'PSName'})
            {
                $pg = $f->{'post'}{'STRINGS'}{$attrs{'PSName'}};
                unless (defined $pg)
                {
                	# Failed to find glyph by the supplied PSName -- see if this is one of two special cases.
                	# These cases exist because FontLab doesn't use the correct (Apple-specified) name for U+000D and U+00A7
                	$pg = $f->{'post'}{'STRINGS'}{'nonmarkingreturn'} if $attrs{'PSName'} eq 'CR';
                	$pg = $f->{'post'}{'STRINGS'}{'macron'} 			if $attrs{'PSName'} eq 'overscore';
                }
				if (defined $pg)
				{
                	$self->APerror($xml, $cur_glyph, undef, "Postscript name: $attrs{'PSName'} resolves to different glyph to Unicode ID: $attrs{'UID'}")
	                        if (defined $ug && $pg != $ug);
	                $cur_glyph->{'gnum'} ||= $pg;
	            }
                else
                {
                	$self->APerror($xml, $cur_glyph, undef, "No glyph associated with postscript name $attrs{'PSName'}") ;
                }
                # delete $attrs{'PSName'};  # Added in MH's version; v0.04: now believed un-needed and un-wanted.
            }
            if (defined $attrs{'GID'})
            {
                $ig = $attrs{'GID'};
                $self->APerror($xml, $cur_glyph, undef, "Specified glyph id $attrs{'GID'} different to glyph of Unicode ID: $attrs{'UID'}")
                        if (defined $ug && $ug != $ig);
                $self->APerror($xml, $cur_glyph, undef, "Specified glyph id $attrs{'GID'} different to glyph of postscript name $attrs{'PSName'}")
                        if (defined $pg && $pg != $ig);
                $self->APerror($xml, $cur_glyph, undef, "Specified glyph id $attrs{'GID'} is >= number of glyphs in font ($numg)")
                        if ($ig < 0 || ($f && $ig >= $numg));
                $cur_glyph->{'gnum'} ||= $ig;
                # delete $attrs{'GID'}; # Added in MH's version; v0.04: now believed un-needed and un-wanted.
            }
            if ($f)
            {
                $cur_glyph->{'post'} = $f->{'post'}{'VAL'}[$cur_glyph->{'gnum'}];
                $cur_glyph->{'uni'} = $reverse[$cur_glyph->{'gnum'}] if (!defined $cur_glyph->{'uni'} && defined $reverse[$cur_glyph->{'gnum'}]);

                if ($cur_glyph->{'glyph'} = $f->{'loca'}{'glyphs'}[$cur_glyph->{'gnum'}])
                {
                    # v0.04: Slight difference in this code and MH's: this code causes
                    # $cur_glyph->{'glyph'} to be defined for all glyphs; in MH's code
                    # it was defined only for non-empty glyphs.
                    $cur_glyph->{'glyph'}->read_dat;
                    if ($cur_glyph->{'glyph'}{'numberOfContours'} > 0)
                    { $cur_glyph->{'props'}{'drawn'} = 1; }
                    $cur_glyph->{'glyph'}->get_points;
                }
                elsif ($opts{'-knownemptyglyphs'})
                {
                    $self->APerror($xml, $cur_glyph, undef, "Empty glyph outline in font") unless $known_empty_glyphs{$cur_glyph->{'post'}};
                }

                # MH's code includes the following two lines, but these are redundant with 
                # assignment $cur_glyph = {%attrs} at start of this block
                #foreach (keys %attrs)
                #{ $cur_glyph->{$_} = $attrs{$_}; }
            }
            else
            {
                my (@basicnames) = qw(.notdef null cr);
#                $numg ||= 3;
                if ($cur_glyph->{'gnum'} > $numg)
                { $numg = $cur_glyph->{'gnum'} + 1; }
                else
                { $cur_glyph->{'gnum'} ||= $numg++; }

                $cur_glyph->{'post'} = $cur_glyph->{'PSName'} || $basicnames[$cur_glyph->{'gnum'}];
                $cur_glyph->{'uni'} = [map {hex($_)} split(' ', $cur_glyph->{'UID'})] if (defined $cur_glyph->{'UID'});
            }
            $cur_glyph->{'line'} = $xml->current_line;
            $self->{'glyphs'}[$cur_glyph->{'gnum'}] = $cur_glyph;

        } elsif ($tag eq 'compound')
        {
            my $component = {%attrs, line => $xml->current_line};
            if (defined $attrs{'UID'})
            {
                $attrs{'UID'} =~ s/^U\+//o;      # Not supposed to contain "U+", but some do
                $component->{'uni'} = [hex($attrs{'UID'})] ;
            }
            push @{$cur_glyph->{'components'}}, $component;
        } elsif ($tag eq 'point')
        {
            if ($omittedAPs{$attrs{'type'}})
            {  undef $cur_pt; }
            else
            {
                $cur_pt = {'name' => $attrs{'type'}, line => $xml->current_line};
                $cur_glyph->{'points'}{$attrs{'type'}} = $cur_pt;
            }
        } elsif ($tag eq 'contour' && defined $cur_pt)
        {
            my ($cont) = $attrs{'num'};
            my ($g) = $cur_glyph->{'glyph'} || return;

            $self->APerror($xml, $cur_glyph, $cur_pt, "Specified contour of $cont different from calculated contour of $cur_pt->{'cont'}")
                    if (defined $cur_pt->{'cont'} && $cur_pt->{'cont'} != $attrs{'num'});

            if (($cont == 0 && $g->{'endPoints'}[0] != 0)
                || ($cont > 0 && $g->{'endPoints'}[$cont-1] + 1 != $g->{'endPoints'}[$cont]))
            { $self->APerror($xml, $cur_glyph, $cur_pt, "Contour $cont not a single point path"); }
            else
            { $cur_pt->{'cont'} = $cont; }

            $cur_pt->{'x'} = $g->{'x'}[$g->{'endPoints'}[$cont]];
            $cur_pt->{'y'} = $g->{'y'}[$g->{'endPoints'}[$cont]];
        } elsif ($tag eq 'location' && defined $cur_pt)
        {
            my ($x) = $attrs{'x'};
            my ($y) = $attrs{'y'};
            my ($g) = $cur_glyph->{'glyph'};
            my ($cont, $i);

            $self->APerror($xml, $cur_glyph, $cur_pt, "Specified location of ($x, $y) different from calculated location ($cur_pt->{'x'}, $cur_pt->{'y'})")
                    if (defined $cur_pt->{'x'} && ($cur_pt->{'x'} != $x || $cur_pt->{'y'} != $y));

            if ($g)
            {
                for ($i = 0; $i < $g->{'numPoints'}; $i++)
                {
                    if ($g->{'x'}[$i] == $x && $g->{'y'}[$i] == $y)
                    {
                        for ($cont = 0; $cont <= $#{$g->{'endPoints'}}; $cont++)
                        {
                            last if ($g->{'endPoints'}[$cont] > $i);
                        }
                    }
                }
                if ($g->{'x'}[$i] != $x || $g->{'y'}[$i] != $y)
                { $self->APerror($xml, $cur_glyph, $cur_pt, "No glyph point at specified location ($x, $y)") if ($opts{'-strictap'}); }
                if (($cont == 0 && $g->{'endPoints'}[0] != 0)
                    || $g->{'endPoints'}[$cont-1] + 1 != $g->{'endPoints'}[$cont])
                { $self->APerror($xml, $cur_glyph, $cur_pt, "Calculated contour $cont not a single point path") if ($opts{'-strictap'}); }
                else
                { $cur_pt->{'cont'} = $cont; }
            }
            else
            { $self->APerror($xml, $cur_glyph, $cur_pt, "No glyph point at specified location ($x, $y)") if ($opts{'-strictap'}); }

            $cur_pt->{'x'} = $x unless defined $cur_pt->{'x'};
            $cur_pt->{'y'} = $y unless defined $cur_pt->{'y'};
        } elsif ($tag eq 'property')
        {
            $cur_glyph->{'props'}{$attrs{'name'}} = $attrs{'value'};
        }
    });

    if ($xml_file)
    {
        $xml->parsefile($xml_file) || return warn "Can't open $xml_file";

        # Make sure to destroy the parser properly -- Otherwise Perl can generate 
        # exception violations during cleanup!
        $xml->release;
        undef $xml;
    }

    $self->{'numg'} = $numg;
# now fill in the glyphs that aren't in the xml
    my ($i);

    for ($i = 0; $i < $numg; $i++)
    {
        next if (defined $self->{'glyphs'}[$i]);

        my ($cur_glyph) = {'gnum' => $i};
        $self->{'glyphs'}[$i] = $cur_glyph;
        next unless ($f);

        $cur_glyph->{'uni'} = $reverse[$i] if (defined $reverse[$i]);
        $cur_glyph->{'post'} = $f->{'post'}{'VAL'}[$i];
        if ($cur_glyph->{'glyph'} = $f->{'loca'}{'glyphs'}[$i])
        {
            # v0.04: Slight difference in this code and MH's: this code causes
            # $cur_glyph->{'glyph'} to be defined for all glyphs; in MH's code
            # it was defined only for non-empty glyphs.
            $cur_glyph->{'glyph'}->read_dat;
            if ($cur_glyph->{'glyph'}{'numberOfContours'} > 0)
            { $cur_glyph->{'props'}{'drawn'} = 1; }
            $cur_glyph->{'glyph'}->get_points;
        }
        elsif ($opts{'-knownemptyglyphs'})
        {
            $self->APerror($xml, $cur_glyph, undef, "Empty glyph outline in font") unless $known_empty_glyphs{$cur_glyph->{'post'}};
        }
    }
    $self;
}


sub make_names
{
    my ($self) = @_;
    my ($numg) = $self->{'numg'};
    my ($i, $gname);

    for ($i = 0; $i < $numg; $i++)
    {
        my ($glyph) = $self->{'glyphs'}[$i];
        next if (defined $glyph->{'name'});
        $gname = $self->make_name($glyph->{'post'}, $glyph->{'uni'}, $glyph);

        while (defined $self->{'glyph_names'}{$gname})
        { $gname =~ s/(?:_(\d+))?$/"_".($1+1)/oe; }
        $self->{'glyph_names'}{$gname} = $i;
        $glyph->{'name'} = $gname;
    }
}


sub make_classes
{
    my ($self, %opts) = @_;
    my ($numg) = $self->{'numg'};
    my (%classes, %namemap);
    my ($g, $gname, $i, $j, $glyph, %used, $p, $name);

    for ($i = 0; $i < $numg; $i++)
    {
        $glyph = $self->{'glyphs'}[$i];
        $gname = $self->make_name($glyph->{'post'}, $glyph->{'uni'}, $glyph);

        if (defined $used{$gname})
        { $gname .= "_1"; }
        while (defined $used{$gname})
        { $gname =~ s/_(\d+)/"_" . ($1 + 1)/oe; }
        $used{$gname}++;
        $glyph->{'name'} = $gname;
        $self->{'glyph_names'}{$gname} = $i;

        foreach $p (keys %{$glyph->{'points'}})
        {
            my ($pname) = $self->make_point($p, $glyph, %opts);
            next unless ($pname);                           # allow for point deletion, in effect.
            if ($p ne $pname)
            {
                $glyph->{'points'}{$pname} = $glyph->{'points'}{$p};
                delete $glyph->{'points'}{$p};
            }
            push (@{$self->{'lists'}{$pname}}, $i);
            vec($self->{'vecs'}{$pname}, $i, 1) = 1 if ($self->{'vecs'});
        }
        foreach (split('/', $glyph->{'post'}))
        { $namemap{$_} = $i; }
        if (defined $glyph->{'props'}{'classes'})
        {
            my ($c);
            foreach $c (split(' ', $glyph->{'props'}{'classes'}))
            {
                $c =~ s/^c//o;
                push (@{$classes{$c}}, $glyph->{'gnum'});
            }
        }
    }

    # need a separate loop since using other glyphs' names
    foreach $glyph (@{$self->{'glyphs'}})
    {
        foreach $name (split('/', $glyph->{'post'}))
        {
            if ($name =~ m/\.([^_.]+)$/o)   # in x.y.z just handle x.y,.z since x,.y will be done
                                            # when processing x.y, etc.
            {
                my ($base, $ext) = ($` , $1);    #` make editor happy
                if ($base && (!defined $classes{"no_$ext"} || defined $namemap{$base}))
                {
                    my ($i) = $namemap{$base};
                    push (@{$classes{$ext}}, $glyph->{'gnum'});
                    push (@{$classes{"no_$ext"}}, $self->{'glyphs'}[$i]{'gnum'});
                }
            }
        }
    }
    $self->{'classes'} = \%classes;

    if ($opts{'-ligatures'})
    {
        my (%ligclasses);

        foreach $glyph (@{$self->{'glyphs'}})
        {
            foreach $name (split('/', $glyph->{'post'}))
            {
                my ($class, $cname);
                my ($ext, $base, @elem) = $self->split_lig($name, $opts{'-ligatures'}, $opts{'-ligtype'});
                next if ($ext || scalar @elem < 2);

                if ($opts{'-ligatures'} eq 'first')
                { 
                    $class = $elem[0];
                    $base = "uni$base" if ($class =~ s/^uni//o);
                    $base =~ s/^_//o;
                }
                else
                { 
                    $class = $elem[-1];
                    $class =~ s/^_//o;
                }

                $cname = $class;
                $cname =~ s/\./_/og;
                next unless ($i = $namemap{$base});
                unless (defined $self->{'ligmap'}{$cname})
                {
                    my ($match) = 0;
                    foreach ($class, "uni$class", "u$class")
                    {
                        if ($j = $namemap{$_})
                        {
                            $match = 1;
                            $self->{'ligmap'}{$cname} = $j;
                            last;
                        }
                    }
                    next unless ($match);
                }
                push (@{$ligclasses{$cname}}, $glyph->{'gnum'});
                push (@{$ligclasses{"no_$cname"}}, $self->{'glyphs'}[$i]{'gnum'});
            }
        }
        $self->{'ligclasses'} = \%ligclasses;
    }
}


sub make_name
{
    my ($self, $gname, $uni, $glyph) = @_;
    $gname =~ s{/.*$}{}o;           # strip alternates
    $gname = defined $uni ? sprintf("u%04x", $uni->[0]) : "glyph$glyph->{'gnum'}" if $gname eq '.notdef';
    $gname ||= ".unk";
    $gname;
}


sub make_point
{
    my ($self, $p, $glyph, %opts) = @_;
    $p;
}


sub align_glyphs
{
    my ($self, $data) = @_;
    my (@map, @revmap, @old, @new, @diff, $s, $g, $u);

    @new = map {$_ ? $_->{'name'} : ""} @{$self->{'glyphs'}};
    @old = map {$_ ? $_->{'name'} : ""} @{$data->{'glyphs'}};
    @diff = sdiff(\@old, \@new);

# first find solid alignments
    foreach $s (@diff)
    {
        if ($s->[0] eq 'u')
        {
            $map[$data->{'glyph_names'}{$s->[1]}] = $self->{'glyph_names'}{$s->[2]};
            $revmap[$self->{'glyph_names'}{$s->[2]}] = $data->{'glyph_names'}{$s->[1]};
        }
    }

# now deal with the rest
    foreach $s (@diff)
    {
        if ($s->[0] eq '-' || $s->[0] eq 'c')
        {
            my ($gnum) = $data->{'glyph_names'}{$s->[1]};
            my ($uni) = $data->{'glyphs'}[$gnum]{'uni'};
            my ($gnew);
    # anything with the same name not already used?
            if ($g = $self->{'glyph_names'}{$s->[1]} and !defined $revmap[$g])
            {
                $map[$gnum] = $g;
                $revmap[$g] = $gnum;
            }
    # anything spare with the same unicode (any unicode the same)?
            else
            {
                foreach $g (@{$self->{'glyphs'}})
                {
                    if ($g->{'uni'} == $uni && !defined $revmap[$g->{'gnum'}])
                    {
                        $gnew = $g->{'gnum'};
                        last;
                    }
                }
                if ($gnew)
                {
                    $map[$gnum] = $gnew;
                    $revmap[$gnew] = $gnum;
                    last;
                }
            }
    # make it a deletion (i.e. in old but not in new)
        }
        elsif ($s->[0] eq '+')
        {
            # nothing to do since only really interested in old->new mapping
        }
    }

# deal with unaligned conflicts and simply align them
    foreach $s (@diff)
    {
        if ($s->[0] eq 'c')
        {
            my ($gnum) = $data->{'glyph_names'}{$s->[1]};
            my ($nnum) = $self->{'glyph_names'}{$s->[2]};
            next if ($map[$gnum] || $revmap[$nnum]);
            $map[$gnum] = $nnum;
            $revmap[$nnum] = $gnum;
        }
    }
    return (@map);
}


sub as_xml
{
    my ($self) = @_;
    my ($numg) = $self->{'numg'};
    my ($res, $i);

    $res = "<?xml version='1.0'?>\n<font";
    foreach (qw(name upem))
    { $res .= " $_='$self->{$_}'" if (defined $self->{$_}); }
    $res .= ">\n\n";

    for ($i = 0; $i < $numg; $i++)
    {
        my ($g) = $self->{'glyphs'}[$i];
        $res .= "<glyph GID='$i'";
        $res .= " PSName='$g->{'post'}'" if (defined $g->{'post'});
        $res .= " UID='" . join(' ', map{sprintf("%04X", $_)} @{$g->{'uni'}}) . "'" if (defined $g->{'uni'});
        $res .= ">\n";
    }

    $res;
}
# Private routine:'

sub split_lig
{
    my ($self, $str, $type, $comp) = @_;
    my ($ext, @res, $base);

    unless ($comp =~ /comp/)
    { $ext = $1 if ($str =~ s/(\.(.*?))$//o); }

    if ($str =~ m/_/o)
    {
        @res = split('_', $str);
        foreach (@res[1..$#res])
        { $_ = "_$_"; }
        $base = $str;
        if ($type =~ /last/)
        { $base =~ s/_([^_]*)$//o; }
        else
        { $base =~ s/^(.*?)_//o; }
    }
    elsif ($str =~ s/^uni//o)
    {
        @res = $str =~ m/([0-9a-fA-F]{4})/og;
        if ($type =~ /last/)
        { $base = "uni" . join('', @res[0 .. ($#res-1)]); }
        else
        { $base = "uni" . join('', @res[1 .. $#res]); }
        $res[0] = "uni$res[0]";
    }
    else
    { $res[0] = $str; }
    ($ext, $base, @res);
}

sub APerror
{
    my $self = shift;
    my ($xml, $cur_glyph, $cur_pt, $str) = @_;

    my $msg;

    if (defined $cur_glyph->{'UID'})
    { $msg = "U+$cur_glyph->{'UID'}: "; }
    elsif (defined $cur_glyph->{'PSName'})
    { $msg =  "$cur_glyph->{'PSName'}: "; }
    elsif (defined $cur_glyph->{'GID'})
    { $msg =  "$cur_glyph->{'GID'}: "; }
    else
    { $msg =  "Undefined: "; }

    $msg .=  $str;

    if (defined $cur_pt)
    { $msg .=  " in point $cur_pt->{'name'}"; }

    $msg .=  " at line " . $xml->current_line if ($xml);
    $msg .= ".\n";
    $self->error($msg);
}


sub error
{
    my $self = shift;
    my $msg = join(' ', @_);
    if (defined $self->{'-errorfh'})
    { print {$self->{'-errorfh'}} $msg; }
    else
    { $self->{'WARNINGS'} .= $msg; }

    $self->{'cWARNINGS'}++;
}