#
# This is a wrapper for FreeType module.
$rcsid = q$Id: FreeTypeWrapper.pm,v 1.19 1998/06/26 19:01:21 jam Exp $;
#
# Copyright (c) 1998  Kazushi (Jam) Marukawa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice in the documentation and/or other materials provided with 
#    the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY
# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 
# PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT 
# OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR 
# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 
# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 
# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN 
# IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#

use FreeType;

$VERSION = substr(q$Revision: 1.19 $, 10);

package FreeTypeOutline;

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;

    # Initialize variables
    $self->{GLYPH} = shift;
    $self->{OUTLINE} = shift;
    die "no 2 args in new FreeTypeOutline\n" unless defined $self->{OUTLINE};

    return $self;
}

sub TT_New_Outline {
    die "not implemented yet, TT_New_Outline\n";
}

sub TT_Done_Outline {
    die "not implemented yet, TT_Done_Outline\n";
}

sub TT_Copy_Outline {
    die "not implemented yet, TT_Copy_Outline\n";
}

sub TT_Transform_Outline {
    my $self = shift;
    my $matrix = shift;
    die "no arg in TT_Transform_Outline\n" unless defined $matrix;
    # no error
    FreeType::TT_Transform_Outline($self->{OUTLINE}, $matrix);
    return 1;
}

sub TT_Translate_Outline {
    my $self = shift;
    my $offx = shift;
    my $offy = shift;
    die "no 2 args in TT_Translate_Outline\n" unless defined $offy;
    # no error
    FreeType::TT_Translate_Outline($self->{OUTLINE}, $offx, $offy);
    return 1;
}

sub TT_Get_Outline_Bitmap {
    die "not implemented yet, TT_Get_Outline_Bitmap\n";
}

sub TT_Get_Outline_Pixmap {
    die "not implemented yet, TT_Get_Outline_Pixmap\n";
}

sub TT_Get_Outline_BBox {
    my $self = shift;
    my $bbox = undef;
    $self->{GLYPH}->{INSTANCE}->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Get_Outline_BBox($self->{OUTLINE}, $bbox);
    return undef if $self->{GLYPH}->{INSTANCE}->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return $bbox;
}

sub transform {
    my $self = shift;
    return $self->TT_Transform_Outline(@_);
}

sub translate {
    my $self = shift;
    return $self->TT_Translate_Outline(@_);
}

sub get_bbox {
    my $self = shift;
    return $self->TT_Get_Outline_BBox();
}


package FreeTypeGlyph;

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;

    # Initialize variables
    die "no arg in new FreeTypeInstance\n" unless @_;
    $self->{INSTANCE} = shift;

    my $glyph;
    $self->{INSTANCE}->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_New_Glyph($self->{INSTANCE}->{FACE}->{FACE}, $glyph);
    return undef if $self->{INSTANCE}->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;

    $self->{GLYPH} = $glyph;
    $self->{INDEX} = undef;
    $self->{FLAGS} = FreeType::TTLOAD_DEFAULT;

    return $self unless @_;

    $self->{INDEX} = shift;
    $self->{FLAGS} = shift;
    $self->{FLAGS} = FreeType::TTLOAD_DEFAULT unless defined $self->{FLAGS};
    $self->load();

    return $self;
}

sub DESTROY {
    my $self = shift;
    $self->{INSTANCE}->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Done_Glyph($self->{GLYPH});
    return undef if $self->{INSTANCE}->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return 1;
}

sub TT_Load_Glyph {
    my $self = shift;
    $self->{INSTANCE}->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Load_Glyph($self->{INSTANCE}->{INSTANCE}, $self->{GLYPH},
				$self->{INDEX}, $self->{FLAGS});
    return undef if $self->{INSTANCE}->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return 1;
}

sub TT_Get_Glyph_Outline {
    my $self = shift;
    my $outline = undef;
    $self->{INSTANCE}->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Get_Glyph_Outline($self->{GLYPH},
				       $outline);
    return undef if $self->{INSTANCE}->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return $outline;
}

sub TT_Get_Glyph_Metrics {
    my $self = shift;
    my $metrics = undef;
    $self->{INSTANCE}->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Get_Glyph_Metrics($self->{GLYPH},
				       $metrics);
    return undef if $self->{INSTANCE}->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return $metrics;
}

sub TT_Get_Glyph_Bitmap {
    my $self = shift;
    die "no arg in bitmap\n" unless @_;
    my $bitmap = shift;
    my $x = 0;
    my $y = 0;
    $x = shift if @_;
    $y = shift if @_;
    $self->{INSTANCE}->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Get_Glyph_Bitmap($self->{GLYPH},
				      $bitmap, $x, $y);
    return undef if $self->{INSTANCE}->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return $bitmap;
}

sub TT_Get_Glyph_Pixmap {
    my $self = shift;
    my $x = 0;
    my $y = 0;
    $x = shift unless @_;
    $y = shift unless @_;
    my $pixmap = undef;
    $self->{INSTANCE}->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Get_Glyph_Pixmap($self->{GLYPH},
				      $pixmap, $x, $y);
    return undef if $self->{INSTANCE}->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return $pixmap;
}

sub load {
    my $self = shift;
    return $self->TT_Load_Glyph();
}

sub outline {
    my $self = shift;
    my $outline = $self->TT_Get_Glyph_Outline();
    return new FreeTypeOutline($self->{GLYPH}, $outline);
}

sub metrics {
    my $self = shift;
    return $self->TT_Get_Glyph_Metrics();
}

sub bitmap {
    my $self = shift;
    return $self->TT_Get_Glyph_Bitmap();
}

sub pixmap {
    my $self = shift;
    return $self->TT_Get_Glyph_Pixmap();
}


package FreeTypeInstance;

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;

    # Initialize variables
    die "no 2 args in new FreeTypeInstance\n" unless $#_ >= 1;
    $self->{FACE} = shift;
    $self->{INSTANCE} = shift;

    return $self;
}

sub DESTROY {
    my $self = shift;
    $self->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Done_Instance($self->{INSTANCE});
    return undef if $self->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return 1;
}

sub TT_Set_Instance_Resolutions {
    my $self = shift;
    die "no 2 args in TT_Set_Instance_Resolutions\n" unless $#_ >= 1;
    my $xres = shift;
    my $yres = shift;
    $self->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Set_Instance_Resolutions($self->{INSTANCE},
					      $xres, $yres);
    return undef if $self->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return 1;
}

sub TT_Set_Instance_CharSize {
    my $self = shift;
    die "no arg in TT_Set_Instance_CharSize\n" unless @_;
    my $charsize = shift;
    $self->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Set_Instance_CharSize($self->{INSTANCE}, $charsize);
    return undef if $self->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return 1;
}

sub TT_Set_Instance_CharSizes {
    my $self = shift;
    die "no 2 args in TT_Set_Instance_CharSizes\n" unless $#_ >= 1;
    my $charwidth = shift;
    my $charheight = shift;
    $self->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Set_Instance_CharSizes($self->{INSTANCE},
					    $charwidth, $charheight);
    return undef if $self->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return 1;
}

sub TT_Set_Pixel_Sizes {
    my $self = shift;
    die "no 3 args in TT_Set_Pixel_Sizes\n" unless $#_ >= 2;
    my $pixelwidth = shift;
    my $pixelheight = shift;
    my $pointsize = shift;
    $self->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Set_Pixel_Sizes($self->{INSTANCE},
				     $pixelwidth, $pixelheight,
				     $pointsize);
    return undef if $self->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return 1;
}

sub TT_Set_Instance_Transform_Flags {
    my $self = shift;
    die "no 2 args in TT_Set_Instance_Transform_Flags\n" unless $#_ >= 1;
    my $rotated = shift;
    my $stretched = shift;
    $self->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Set_Instance_Transform_Flags($self->{INSTANCE},
						  $rotated, $stretched);
    return undef if $self->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return 1;
}

sub TT_Get_Instance_Metrics {
    my $self = shift;
    my $imetrics = undef;
    $self->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Get_Instance_Metrics($self->{INSTANCE},
					  $imetrics);
    return undef if $self->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return $imetrics;
}

sub TT_Set_Instance_Pointer {
    my $self = shift;
    die "no arg in TT_Set_Instance_Transform_Flags\n" unless @_;
    my $data = shift;
    $self->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Set_Instance_Pointer($self->{INSTANCE}, $data);
    return undef if $self->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return 1;
}

sub TT_Get_Instance_Pointer {
    my $self = shift;
    return FreeType::TT_Get_Instance_Pointer($self->{INSTANCE});
}

sub set_resolutions {
    my $self = shift;
    return $self->TT_Set_Instance_Resolutions(@_);
}

sub set_charsize {
    my $self = shift;
    return $self->TT_Set_Instance_CharSize(@_);
}

sub set_charsizes {
    my $self = shift;
    return $self->TT_Set_Instance_CharSizes(@_);
}

sub set_pixelsizes {
    my $self = shift;
    return $self->TT_Set_Pixel_Sizes(@_);
}

sub set_flags {
    my $self = shift;
    return $self->TT_Set_Instance_Transform_Flags(@_);
}

sub metrics {
    my $self = shift;
    return $self->TT_Get_Instance_Metrics(@_);
}


package FreeTypeFace;

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;

    # Initialize variables
    die "no 3 args in new FreeTypeFace\n" unless $#_ >= 2;
    $self->{FONT} = shift;
    $self->{NUM} = shift;
    $self->{FACE} = shift;

    return $self;
}

sub DESTROY {
    my $self = shift;
    $self->{FONT}->{ERROR} =
	FreeType::TT_Close_Face($self->{FACE});
    return undef if $self->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return 1;
}

sub TT_Get_Face_Properties {
    my $self = shift;
    my $prop = undef;
    $self->{FONT}->{ERROR} =
	FreeType::TT_Get_Face_Properties($self->{FACE}, $prop);
    return undef if $self->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return $prop;
}

sub TT_Set_Face_Pointer {
    my $self = shift;
    die "no arg in TT_Set_Face_Pointer\n" unless @_;
    my $data = shift;
    $self->{FONT}->{ERROR} =
	FreeType::TT_Set_Face_Pointer($self->{FACE}, $data);
    return undef if $self->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return 1;
}

sub TT_Get_Face_Pointer {
    my $self = shift;
    return FreeType::TT_Get_Face_Pointer($self->{FACE});
}

sub TT_Flush_Face {
    my $self = shift;
    $self->{FONT}->{ERROR} =
	FreeType::TT_Flush_Face($self->{FACE});
    return undef if $self->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return 1;
}

sub TT_New_Instance {
    my $self = shift;
    my $instance = undef;
    $self->{FONT}->{ERROR} =
	FreeType::TT_New_Instance($self->{FACE}, $instance);
    return undef if $self->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    return $instance;
}

sub TT_Get_CharMap_Count {
    my $self = shift;
    my $num = FreeType::TT_Get_CharMap_Count($self->{FACE});
    if ($num < 0) {
	$self->{FONT}->{ERROR} = TT_Err_Invalid_Face_Handle;
	return undef 
    }
    return $num;
}

sub TT_Get_Name_Count {
    my $self = shift;
    my $num = FreeType::TT_Get_Name_Count($self->{FACE});
    if ($num < 0) {
	$self->{FONT}->{ERROR} = TT_Err_Invalid_Face_Handle;
	return undef 
    }
    return $num;
}

sub new_instance {
    my $self = shift;
    my $instance = $self->TT_New_Instance();
    return undef unless defined $instance;
    return new FreeTypeInstance($self, $instance);
}

sub charmapnum {
    my $self = shift;
    return $self->TT_Get_CharMap_Count;
}

sub namenum {
    my $self = shift;
    return $self->TT_Get_Name_Count;
}

# See http://www.microsoft.com/typography/OTSPEC/os2.htm

my @microsoftUnicodeRangeDescriptions =
    ( "Basic Latin", "Latin-1 Supplement", "Latin Extended-A", "Latin Extended-B",
      "IPA Extensions", "Spacing Modifier Letters", "Combining Diacritical Marks", "Greek",
      undef, "Cyrillic", "Armenian", "Hebrew",
      undef, "Arabic", undef, "Devanagari",
      "Bengali", "Gurmukhi", "Gujarati", "Oriya",
      "Tamil", "Telugu", "Kannada", "Malayalam",
      "Thai", "Lao", "Georgian", undef,
      "Hangul Jamo", "Latin Extended Additional", "Greek Extended", "General Punctuation",
      "Superscripts And Subscripts", "Currency Symbols", "Combining Diacritical Marks For Symbols", "Letterlike Symbols",
      "Number Forms", "Arrows", "Mathematical Operators", "Miscellaneous Technical",
      "Control Pictures", "Optical Character Recognition", "Enclosed Alphanumerics", "Box Drawing",
      "Block Elements", "Geometric Shapes", "Miscellaneous Symbols", "Dingbats",
      "CJK Symbols And Punctuation", "Hiragana", "Katakana", "Bopomofo",
      "Hangul Compatibility Jamo", "CJK Miscellaneous", "Enclosed CJK Letters And Months", "CJK Compatibility",
      "Hangul", "Surrogates", undef, "CJK Unified Ideographs",
      "Private Use Area", "CJK Compatibility Ideographs", "Alphabetic Presentation Forms", "Arabic Presentation Forms-A",
      "Combining Half Marks", "CJK Compatibility Forms", "Small Form Variants", "Arabic Presentation Forms-B",
      "Halfwidth And Fullwidth Forms", "Specials", "Tibetan", undef );
      # 72-127 are undef

sub get_unicoderange {
    my $self = shift;
    my $prop = $self->TT_Get_Face_Properties();
    my $ret = "";
    my $index = 0;
    for (my $i = 0; $i < 4; $i++) {
	my $v = undef;
	$v = $prop->{os2}->{ulUnicodeRange1} if $i == 0;
	$v = $prop->{os2}->{ulUnicodeRange2} if $i == 1;
	$v = $prop->{os2}->{ulUnicodeRange3} if $i == 2;
	$v = $prop->{os2}->{ulUnicodeRange4} if $i == 3;
	my $bit = 1;
	for (my $j = 0; $j < 32; $j++) {
	    if ($v & $bit) {
		if (defined $microsoftUnicodeRangeDescriptions[$index]) {
		    $ret .= "$microsoftUnicodeRangeDescriptions[$index], ";
		} else {
		    $ret .= "unknown $index bit, ";
		}
	    }
	    $index++;
	    $bit <<= 1;
	}
    }
    $ret =~ s/, $//;
    return $ret;
}

# See http://www.microsoft.com/typography/OTSPEC/os2.htm

my @microsoftCodePageRangeDescriptions =
    ( "Latin 1", "Latin 2: Eastern Europe", "Cyrillic", "Greek",
      "Turkish", "Hebrew", "Arabic", "Windows Baltic",
      "Vietnamese", undef, undef, undef, 
      undef, undef, undef, undef,
      "Thai", "JIS/Japan", "Chinese: Simplified chars -- PRC and Singapore", "Korean Wansung",
      "Chinese: Traditional chars -- Taiwan and Hong Kong", "Korean Johab", undef, undef,
      undef, undef, undef, undef,
      undef, "Machintosh Character Set (US Roman)", "OEM Character Set", "Symbol Character Set",
      undef, undef, undef, undef,
      undef, undef, undef, undef,
      undef, undef, undef, undef,
      undef, undef, undef, undef,
      "IBM Greek", "MS-DOS Russian", "MS-DOS Nordic", "Arabic",
      "MS-DOS Canadian French", "Hebrew", "MS-DOS Icelandic", "MS-DOS Portuguese",
      "IBM Turkish", "IBM Cyrillic; primarily Russian", "Latin 2", "MS-DOS Baltic",
      "Greek; former 437 G", "Arabic; ASMO 708", "WE/Latin1", "US" );

sub get_codepagerange {
    my $self = shift;
    my $prop = $self->TT_Get_Face_Properties();
    my $ret = "";
    my $index = 0;
    for (my $i = 0; $i < 2; $i++) {
	my $v = undef;
	$v = $prop->{os2}->{ulCodePageRange1} if $i == 0;
	$v = $prop->{os2}->{ulCodePageRange2} if $i == 1;
	my $bit = 1;
	for (my $j = 0; $j < 32; $j++) {
	    if ($v & $bit) {
		if (defined $microsoftCodePageRangeDescriptions[$index]) {
		    $ret .= "$microsoftCodePageRangeDescriptions[$index], ";
		} else {
		    $ret .= "unknown $index bit, ";
		}
	    }
	    $index++;
	    $bit <<= 1;
	}
    }
    $ret =~ s/, $//;
    return $ret;
}

# See http://fonts.apple.com/TTRefMan/RM06/Chap6OS2.html and
# http://www.microsoft.com/typography/OTSPEC/os2.htm

%usWeightClassDescriptions =
    ( 1 => "Ultra-light",	# 1-9 are defined by Apple
      2 => "Extra-light",
      3 => "Light",
      4 => "Semi-light",
      5 => "Medium (Normal)",
      6 => "Semi-bold",
      7 => "Bold",
      8 => "Extra-bold",
      9 => "Ultra-bold",
      100 => "Thin",		# 100-900 are defined by Microsoft
      200 => "Extra-light (Ultra-light)",
      300 => "Light",
      400 => "Normal (Regular)",
      500 => "Medium",
      600 => "Semi-bold (Demi-bold)",
      700 => "Bold",
      800 => "Extra-Bold (Ultra-Bold)",
      900 => "Black (Heavy)" );

sub get_weightclass {
    my $self = shift;
    my $prop = $self->TT_Get_Face_Properties();
    my $v = $prop->{os2}->{usWeightClass};
    return $usWeightClassDescriptions{$v}
	if defined $usWeightClassDescriptions{$v};
    return "Unknown $v";
}

# See http://www.microsoft.com/typography/OTSPEC/os2.htm

@usWidthClassDescriptions =
    ( undef, "Ultra condensed", "Extra-condensed", "Condensed",
      "Semi-condensed", "Medium (normal)", "Semi-expanded", "Expanded",
      "Extra-expanded", "Ultra-expanded" );

sub get_widthclass {
    my $self = shift;
    my $prop = $self->TT_Get_Face_Properties();
    my $v = $prop->{os2}->{usWidthClass};
    return $usWidthClassDescriptions[$v]
	if defined $usWidthClassDescriptions[$v];
    return "Unknown $v";
}

# See http://www.microsoft.com/typography/OTSPEC/os2.htm

@fsSelectionDescriptions =
    ( "ITALIC", "UNDERSCORE", "NEGATIVE", "OUTLINED",
      "STRIKEOUT", "BOLD", "REGULAR" );

sub get_selection {
    my $self = shift;
    my $prop = $self->TT_Get_Face_Properties();
    my $ret = "";
    my $index = 0;
    my $v = $prop->{os2}->{fsSelection};
    my $bit = 1;
    for (my $j = 0; $j < 32; $j++) {
	if ($v & $bit) {
	    if (defined $fsSelectionDescriptions[$index]) {
		$ret .= "$fsSelectionDescriptions[$index], ";
	    } else {
		$ret .= "unknown $index bit, ";
	    }
	}
	$index++;
	$bit <<= 1;
    }
    $ret =~ s/, $//;
    return $ret;
}


#
# FreeTypeWrapper
#
#   There are facenum(), open_face(), open_collection()
#  and TT_Set_Raster_Palette() functions.
#
# e.g.
#   $font = new FreeTypeWrapper($fn);
#   for ($i = 0; $i < $font->facenum; $i++) {
#     $face = $font->open_collection($i);
#
#     # work with this face...
#   }
#

package FreeTypeWrapper;

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;

    # Initialize variables
    $self->{ENGINE} = undef;
    die "no arg in new FreeTypeWrapper\n" unless @_;
    $self->{FONTFILE} = shift;
    $self->{PROP} = undef;
    $self->{ERROR} = FreeType::TT_Err_Ok;

    # Open font and initialize FreeType.
    $self->{ERROR} = FreeType::TT_Init_FreeType($self->{ENGINE});
    return undef unless $self->warn();
    my $face = $self->open_face();
    return undef unless $self->warn();
    $self->{PROP} = $face->TT_Get_Face_Properties();

    return $self;
}

sub DESTROY {
    my $self = shift;
    $self->{ERROR} = FreeType::TT_Done_FreeType($self->{ENGINE});
    return undef if $self->{ERROR} != FreeType::TT_Err_Ok;
    return 1;
}

sub TT_Open_Face {
    my $self = shift;
    my $face = undef;
    $self->{ERROR} = FreeType::TT_Open_Face($self->{ENGINE},
					    $self->{FONTFILE}, $face);
    return undef if $self->{ERROR} != FreeType::TT_Err_Ok;
    return $face;
}

sub TT_Open_Collection {
    my $self = shift;
    die "no arg in TT_Open_Collection\n" unless @_;
    my $n = shift;
    my $face = undef;
    $self->{ERROR} =
	FreeType::TT_Open_Collection($self->{ENGINE}, $self->{FONTFILE},
				     $n, $face);
    return undef if $self->{ERROR} != FreeType::TT_Err_Ok;
    return $face;
}

sub TT_Set_Raster_Palette {
    my $self = shift;
    die "no arg in TT_Set_Raster_Pallete\n" unless @_;
    my $palette = shift;
    $self->{ERROR} =
	FreeType::TT_Set_Raster_Palette($self->{ENGINE}, $palette);
    return undef if $self->{ERROR} != FreeType::TT_Err_Ok;
    return 1;
}

my %errcode2string =
    ( 0x0000 => "Ok",
      0x0001 => "Invalid Face Handle",
      0x0002 => "Invalid_Instance_Handle",
      0x0003 => "Invalid_Glyph_Handle",
      0x0004 => "Invalid_CharMap_Handle",
      0x0005 => "Invalid_Result_Address",
      0x0006 => "Invalid_Glyph_Index",
      0x0007 => "Invalid_Argument",
      0x0008 => "Could_Not_Open_File",
      0x0009 => "File_Is_Not_Collection",
      0x000a => "Table_Missing",
      0x000b => "Invalid_Horiz_Metrics",
      0x000c => "Invalid_CharMap_Format",
      0x000d => "Invalid_PPem",
      0x0010 => "Invalid_File_Format",
      0x0020 => "Invalid_Engine",
      0x0021 => "Too_Many_Extensions",
      0x0022 => "Extensions_Unsupported",
      0x0023 => "Invalid_Extension_Id",
      0x0080 => "Max_Profile_Missing",
      0x0081 => "Header_Table_Missing",
      0x0082 => "Horiz_Header_Missing",
      0x0083 => "Locations_Missing",
      0x0084 => "Name_Table_Missing",
      0x0085 => "CMap_Table_Missing",
      0x0086 => "Hmtx_Table_Missing",
      0x0087 => "OS2_Table_Missing",
      0x0088 => "Post_Table_Missing",
      0x0100 => "Out_Of_Memory",
      0x0200 => "Invalid_File_Offset",
      0x0201 => "Invalid_File_Read",
      0x0202 => "Invalid_Frame_Access",
      0x0300 => "Too_Many_Points",
      0x0301 => "Too_Many_Contours",
      0x0302 => "Invalid_Composite_Glyph",
      0x0303 => "Too_Many_Ins",
      0x0400 => "Invalid_Opcode",
      0x0401 => "Too_Few_Arguments",
      0x0402 => "Stack_Overflow",
      0x0403 => "Code_Overflow",
      0x0404 => "Bad_Argument",
      0x0405 => "Divide_By_Zero",
      0x0406 => "Storage_Overflow",
      0x0407 => "Cvt_Overflow",
      0x0408 => "Invalid_Reference",
      0x0409 => "Invalid_Distance",
      0x040a => "Interpolate_Twilight",
      0x040b => "Debug_Opcode",
      0x040c => "ENDF_In_Exec_Stream",
      0x040d => "Out_Of_CodeRanges",
      0x040e => "Nested_DEFS",
      0x040f => "Invalid_CodeRange",
      0x0410 => "Invalid_Displacement",
      0x0500 => "Nested_Frame_Access",
      0x0501 => "Invalid_Cache_List",
      0x0502 => "Could_Not_Find_Context",
      0x0503 => "Unlisted_Object",
      0x0600 => "Raster_Pool_Overflow",
      0x0601 => "Raster_Negative_Height",
      0x0602 => "Raster_Invalid_Value",
      0x0603 => "Raster_Not_Initialized",
      0x0a00 => "Invalid_Kerning_Table_Format",
      0x0a01 => "Invalid_Kerning_Table" );

sub errstring {
    my $self = shift;
    return $errcode2string{$self->{ERROR}}
	if $errcode2string{$self->{ERROR}};
    return undef;
}

sub warn {
    my $self = shift;
    if ($self->{ERROR} != FreeType::TT_Err_Ok) {
	my $str = $self->errstring();
	warn "$str\n" if defined $str;
	$self->{ERROR} = FreeType::TT_Err_Ok;
	return undef;
    }
    return 1;
}

sub facenum {
    my $self = shift;
    return 1 if $self->{PROP}->{num_Faces} <= 0;
    return $self->{PROP}->{num_Faces};
}

sub open_face {
    my $self = shift;
    my $face = $self->TT_Open_Face();
    return undef unless defined $face;
    return new FreeTypeFace($self, 0, $face);
}

sub open_collection {
    my $self = shift;
    die "no arg in open_collection\n" unless @_;
    my $n = shift;
    my $face = $self->TT_Open_Collection($n);
    return undef unless defined $face;
    return new FreeTypeFace($self, $n, $face);
}


#
# FreeTypeCharMap
#
#   There are platform(), encoding() and convert() functions.
#
# e.g.
#   my $charmapnum = $face->CharMapNum;
#   for (my $j = 0; $j < $charmapnum; $j++) {
#     my $charmap = new FreeTypeCharMap($face, $j);
#
#     if ($charmap->platform =~ /Microsoft/ &&
#         $charmap->encoding =~ /Unicode/) {
#       print "$input is converted into ", $charmap->convert($input), "\n";
#     }
#   }
#

package FreeTypeCharMap;

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;

    # Initialize variables
    die "no 2 args in new FreeTypeCharMap\n" unless $#_ >= 1;
    $self->{FACE} = shift;
    $self->{NUM} = shift;
    my $platformID = undef;
    my $encodingID = undef;
    my $charmap = undef;
    $self->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Get_CharMap_ID($self->{FACE}->{FACE}, $self->{NUM},
				    $platformID, $encodingID);
    return undef if $self->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    $self->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Get_CharMap($self->{FACE}->{FACE},
				 $self->{NUM}, $charmap);
    return undef if $self->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    $self->{PLATFORMID} = $platformID;
    $self->{ENCODINGID} = $encodingID;
    $self->{CHARMAP} = $charmap;
    return $self;
}

sub TT_Char_Index {
    my $self = shift;
    die "no arg in TT_Char_Index\n" unless @_;
    my $charcode = shift;
    my $num = FreeType::TT_Char_Index($self->{CHARMAP}, $charcode);
    if ($num < 0) {
	$self->{FACE}->{FONT}->{ERROR} = TT_Err_Invalid_CharMap_Handle;
	return undef 
    }
    return $num;
}

sub platformID {
    my $self = shift;
    return $self->{PLATFORMID};
}

sub encodingID {
    my $self = shift;
    return $self->{ENCODINGID};
}

sub convert {
    my $self = shift;
    die "no arg in convert\n" unless @_;
    return $self->TT_Char_Index(shift);
}

my @charmapPlatform = ( "Apple", "Macintosh", "maybe ISO", "Microsoft");

sub platform {
    my $self = shift;
    return $charmapPlatform[$self->{PLATFORMID}]
	if defined $charmapPlatform[$self->{PLATFORMID}];
    return "Unknown $self->{PLATFORMID}";
}

# See http://fonts.apple.com/TTRefMan/RM06/Chap6name.html

my @charmapAppleEncodings =
    ( "Unicode defaut semantics",
      "Unicode version 1.1 semantics",
      "Unicode ISO 10646 1993 semantics",
      "Unicode 2.0 semantics" );

my @charmapMacintoshEncodings =
    ( "Roman", "Japanese", "Traditional Chinese", "Korean", "Arabic", "Hebrew",
      "Greek", "Russian", "RSymbol", "Devanagari", "Gurmukhi",
      "Gujarati", "Oriya", "Bengali", "Tamil", "Telugu", "Kannada",
      "Malayalam", "Sinhalese", "Burmese", "Khmer", "Thai", "Laotian",
      "Georgian", "Armenian", "Simplified Chinese", "Tibetan", "Mongolian",
      "Geez", "Slavic", "Vietnamese", "Sindhi", "(Uninterpreted)" );

# See http://www.microsoft.com/typography/OTSPEC/cmap.htm

my @charmapMicrosoftEncodings =
    ( "Symbol", "Unicode", "ShiftJIS", "Big5", "PRC", "Wansung",
      "Johab" );

sub encoding {
    my $self = shift;
    if ($self->{PLATFORMID} == 0) {
				# Apple
	return $charmapAppleEncodings[$self->{ENCODINGID}]
	    if defined $charmapAppleEncodings[$self->{ENCODINGID}];
	return "unknown $self->{ENCODINGID}";
    } elsif ($self->{PLATFORMID} == 1) {
				# Script manager code
	return $charmapMacintoshEncodings[$self->{ENCODINGID}]
	    if defined $charmapMacintoshEncodings[$self->{ENCODINGID}];
	return "unknown $self->{ENCODINGID}";
    } elsif ($self->{PLATFORMID} == 2) {
	return "7-bit ASCII" if $self->{ENCODINGID} == 0;
	return "10646" if $self->{ENCODINGID} == 1;
	return "8859-1" if $self->{ENCODINGID} == 2;
	return "unknown $self->{ENCODINGID}";
    } elsif ($self->{PLATFORMID} == 3) {
				# Microsoft encoding
	return $charmapMicrosoftEncodings[$self->{ENCODINGID}]
	    if defined $charmapMicrosoftEncodings[$self->{ENCODINGID}];
	return "unknown $self->{ENCODINGID}";
    } else {
	return "unknown $self->{ENCODINGID}";
    }
}


#
# FreeTypeName
#
#   There are platform(), encoding(), language(), name(), nameLong()
#  and string() functions.
#
# e.g.
#   $count = $face->namenum();
#   for ($j = 0; $j < $count; $j++) {
#     $name = new FreeTypeName($face, $j);
#     $string = $name->string();
#
#     printf("$fn: $i: $j name: %s, %s, %s, %s: %s\n",
#       $name->platform, $name->encoding, $name->language,
#       $name->name, $string) unless $opt_d;
#   }
#

package FreeTypeName;

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;

    # Initialize variables
    die "no 2 args in new FreeTypeName\n" unless $#_ >= 1;
    $self->{FACE} = shift;
    $self->{NUM} = shift;
    my $platformID = undef;
    my $encodingID = undef;
    my $languageID = undef;
    my $namedescID = undef;
    my $string = undef;
    $self->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Get_Name_ID($self->{FACE}->{FACE}, $self->{NUM},
				 $platformID, $encodingID, $languageID,
				 $namedescID);
    return undef if $self->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    $self->{FACE}->{FONT}->{ERROR} =
	FreeType::TT_Get_Name_String($self->{FACE}->{FACE},
				     $self->{NUM}, $string);
    return undef if $self->{FACE}->{FONT}->{ERROR} != FreeType::TT_Err_Ok;
    $self->{PLATFORMID} = $platformID;
    $self->{ENCODINGID} = $encodingID;
    $self->{LANGUAGEID} = $languageID;
    $self->{NAMEDESCID} = $namedescID;
    $self->{STRING} = $string;
    return $self;
}

sub platformID {
    my $self = shift;
    return $self->{PLATFORMID};
}

sub encodingID {
    my $self = shift;
    return $self->{ENCODINGID};
}

sub languageID {
    my $self = shift;
    return $self->{LANGUAGEID};
}

sub namedescID {
    my $self = shift;
    return $self->{NAMEDESCID};
}

my @namePlatform = ( "Apple", "Macintosh", "ISO", "Microsoft");

sub platform {
    my $self = shift;
    return $namePlatform[$self->{PLATFORMID}]
	if defined $namePlatform[$self->{PLATFORMID}];
    return "Unknown $self->{PLATFORMID}";
}

# See http://fonts.apple.com/TTRefMan/RM06/Chap6name.html

my @nameAppleEncodings =
    ( "Unicode defaut semantics",
      "Unicode version 1.1 semantics",
      "Unicode ISO 10646 1993 semantics",
      "Unicode 2.0 semantics" );

my @nameMacintoshEncodings =
    ( "Roman", "Japanese", "Traditional Chinese", "Korean", "Arabic", "Hebrew",
      "Greek", "Russian", "RSymbol", "Devanagari", "Gurmukhi",
      "Gujarati", "Oriya", "Bengali", "Tamil", "Telugu", "Kannada",
      "Malayalam", "Sinhalese", "Burmese", "Khmer", "Thai", "Laotian",
      "Georgian", "Armenian", "Simplified Chinese", "Tibetan", "Mongolian",
      "Geez", "Slavic", "Vietnamese", "Sindhi", "(Uninterpreted)" );

# See http://www.microsoft.com/typography/OTSPEC/name.htm

my @nameMicrosoftEncodings =
    ( "Undefined character set or indexing scheme", "Unicode",
      undef, undef, "WGL4" );

# WGL4?
# doc says nothing, ftdump source says WGL4.

sub encoding {
    my $self = shift;
    if ($self->{PLATFORMID} == 0) {
				# Apple
	return $nameAppleEncodings[$self->{ENCODINGID}]
	    if defined $nameAppleEncodings[$self->{ENCODINGID}];
	return "unknown $self->{ENCODINGID}";
    } elsif ($self->{PLATFORMID} == 1) {
				# Script manager code
	return $nameMacintoshEncodings[$self->{ENCODINGID}]
	    if defined $nameMacintoshEncodings[$self->{ENCODINGID}];
	return "unknown $self->{ENCODINGID}";
    } elsif ($self->{PLATFORMID} == 2) {
	return "7-bit ASCII" if $self->{ENCODINGID} == 0;
	return "10646" if $self->{ENCODINGID} == 1;
	return "8859-1" if $self->{ENCODINGID} == 2;
	return "unknown $self->{ENCODINGID}";
    } elsif ($self->{PLATFORMID} == 3) {
				# Microsoft encoding
	return $nameMicrosoftEncodings[$self->{ENCODINGID}]
	    if defined $nameMicrosoftEncodings[$self->{ENCODINGID}];
	return "unknown $self->{ENCODINGID}";
    } else {
	return "unknown $self->{ENCODINGID}";
    }
}

# See http://fonts.apple.com/TTRefMan/RM06/Chap6name.html

my %nameMacintoshLanguages =
    ( 0 => "English",
      1 => "French",
      2 => "German",
      3 => "Italian",
      4 => "Dutch",
      5 => "Swedish",
      6 => "Spanish",
      7 => "Danish",
      8 => "Portuguese",
      9 => "Norwegian",
      10 => "Hebrew",
      11 => "Japanese",
      12 => "Arabic",
      13 => "Finnish",
      14 => "Greek",
      15 => "Icelandic",
      16 => "Maltese",
      17 => "Turkish",
      18 => "Croatian",
      19 => "Chinese (Traditional)",
      20 => "Urdu",
      21 => "Hindi",
      22 => "Thai",
      23 => "Korean",
      24 => "Lithuanian",
      25 => "Polish",
      26 => "Hungarian",
      27 => "Estonian",
      28 => "Lettish",
      29 => "Saamisk",
      30 => "Faeroese",
      31 => "Farsi",
      32 => "Russian",
      33 => "Chinese (Simplified)",
      34 => "Flemish",
      35 => "Irish",
      36 => "Albanian",
      37 => "Romanian",
      38 => "Czech",
      39 => "Slovak",
      40 => "Slovenian",
      41 => "Yiddish",
      42 => "Serbian",
      43 => "Macedonian",
      44 => "Bulgarian",
      45 => "Ukrainian",
      46 => "Byelorussian",
      47 => "Uzbek",
      48 => "Kazakh",
      49 => "Azerbaijani",
      50 => "Azerbaijani (Armenian script)",
      51 => "Armenian",
      52 => "Georgian",
      53 => "Moldavian",
      54 => "Kirghiz",
      55 => "Tajiki",
      56 => "Turkmen",
      57 => "Mongolian",
      58 => "Mongolian (Cyrillic script)",
      59 => "Pashto",
      60 => "Kurdish",
      61 => "Kashmiri",
      62 => "Sindhi",
      63 => "Tibetan",
      64 => "Nepali",
      65 => "Sanskrit",
      66 => "Marathi",
      67 => "Bengali",
      68 => "Assamese",
      69 => "Gujarati",
      70 => "Punjabi",
      71 => "Oriya",
      72 => "Malayalam",
      73 => "Kannada",
      74 => "Tamil",
      75 => "Telugu",
      76 => "Sinhalese",
      77 => "Burmese",
      78 => "Khmer",
      79 => "Lao",
      80 => "Vietnamese",
      81 => "Indonesian",
      82 => "Tagalog",
      83 => "Malay (Roman script)",
      84 => "Malay (Arabic script)",
      85 => "Amharic",
      86 => "Tigrinya",
      87 => "Galla",
      88 => "Somali",
      89 => "Swahili",
      90 => "Ruanda",
      91 => "Rundi",
      92 => "Chewa",
      93 => "Malagasy",
      94 => "Esperanto",
      128 => "Welsh",
      129 => "Basque",
      130 => "Catalan",
      131 => "Latin",
      132 => "Quechua",
      133 => "Guarani",
      134 => "Aymara",
      135 => "Tatar",
      136 => "Uighur",
      137 => "Dzongkha",
      138 => "Javanese",
      139 => "Sundanese" );

# See http://www.microsoft.com/typography/OTSPEC/lcid-cp.txt

my %nameMicrosoftLanguages =
    ( 0x0401 => "Arabic - Saudi Arabia",
      0x0801 => "Arabic - Iraq",
      0x0c01 => "Arabic - Egypt",
      0x1001 => "Arabic - Libya",
      0x1401 => "Arabic - Algeria",
      0x1801 => "Arabic - Morocco",
      0x1c01 => "Arabic - Tunisia",
      0x2001 => "Arabic - Oman",
      0x2401 => "Arabic - Yemen",
      0x2801 => "Arabic - Syria",
      0x2c01 => "Arabic - Jordan",
      0x3001 => "Arabic - Lebanon",
      0x3401 => "Arabic - Kuwait",
      0x3801 => "Arabic - U.A.E.",
      0x3c01 => "Arabic - Bahrain",
      0x4001 => "Arabic - Qatar",
      0x0402 => "Bulgarian - Bulgaria",
      0x0403 => "Catalan - Spain",
      0x0404 => "Chinese - Taiwan",
      0x0804 => "Chinese - PRC",
      0x0c04 => "Chinese - Hong Kong",
      0x1004 => "Chinese - Singapore",
      0x1404 => "Chinese - Macau",
      0x0405 => "Czech - Czech Republic",
      0x0406 => "Danish - Denmark",
      0x0407 => "German - Germany",
      0x0807 => "German - Switzerland",
      0x0c07 => "German - Austria",
      0x1007 => "German - Luxembourg",
      0x1407 => "German - Liechtenstei",
      0x0408 => "Greek - Greec",
      0x0409 => "English - United States",
      0x0809 => "English - United Kingdom",
      0x0c09 => "English - Australia",
      0x1009 => "English - Canada",
      0x1409 => "English - New Zealand",
      0x1809 => "English - Ireland",
      0x1c09 => "English - South Africa",
      0x2009 => "English - Jamaica",
      0x2409 => "English - Caribbean",
      0x2809 => "English - Belize",
      0x2c09 => "English - Trinidad",
      0x3009 => "English - Zimbabwe",
      0x3409 => "English - Philippines",
      0x040a => "Spanish - Spain (Traditional Sort)",
      0x080a => "Spanish - Mexico",
      0x0c0a => "Spanish - Spain (International Sort)",
      0x100a => "Spanish - Guatemala",
      0x140a => "Spanish - Costa Rica",
      0x180a => "Spanish - Panama",
      0x1c0a => "Spanish - Dominican Republic",
      0x200a => "Spanish - Venezuela",
      0x240a => "Spanish - Colombia",
      0x280a => "Spanish - Peru",
      0x2c0a => "Spanish - Argentina",
      0x300a => "Spanish - Ecuador",
      0x340a => "Spanish - Chile",
      0x380a => "Spanish - Uruguay",
      0x3c0a => "Spanish - Paraguay",
      0x400a => "Spanish - Bolivia",
      0x440a => "Spanish - El Salvador",
      0x480a => "Spanish - Honduras",
      0x4c0a => "Spanish - Nicaragua",
      0x500a => "Spanish - Puerto Rico",
      0x040b => "Finnish - Finland",
      0x040c => "French - France",
      0x080c => "French - Belgium",
      0x0c0c => "French - Canada",
      0x100c => "French - Switzerland",
      0x140c => "French - Luxembourg",
      0x180c => "French - Monaco",
      0x040d => "Hebrew - Israel",
      0x040e => "Hungarian - Hungary",
      0x040f => "Icelandic - Iceland",
      0x0410 => "Italian - Italy",
      0x0810 => "Italian - Switzerland",
      0x0411 => "Japanese - Japan",
      0x0412 => "Korean (Extended Wansung) - Korea",
      0x0413 => "Dutch - Netherlands",
      0x0813 => "Dutch - Belgium",
      0x0414 => "Norwegian - Norway (Bokmal)",
      0x0814 => "Norwegian - Norway (Nynorsk)",
      0x0415 => "Polish - Poland",
      0x0416 => "Portuguese - Brazil",
      0x0816 => "Portuguese - Portugal",
      0x0417 => "Rhaeto-Romanic",
      0x0418 => "Romanian - Romania",
      0x0419 => "Russian - Russia",
      0x041a => "Croatian - Croatia",
      0x081a => "Serbian - Serbia (Latin)",
      0x0c1a => "Serbian - Serbia (Cyrillic)",
      0x041b => "Slovak - Slovakia",
      0x041c => "Albanian - Albania",
      0x041d => "Swedish - Sweden",
      0x081d => "Swedish - Finland",
      0x041e => "Thai - Thailand",
      0x041f => "Turkish - Turkey",
      0x0420 => "Urdu - Pakistan",
      0x0421 => "Indonesian - Indonesia",
      0x0422 => "Ukrainian - Ukraine",
      0x0423 => "Belarusian - Belarus",
      0x0424 => "Slovene - Slovenia",
      0x0425 => "Estonian - Estonia",
      0x0426 => "Latvian - Latvia",
      0x0427 => "Lithuanian - Lithuania",
      0x0827 => "Classic Lithuanian - Lithuania",
      0x0429 => "Farsi - Iran",
      0x042a => "Vietnamese - Viet Nam",
      0x042b => "Armenian - Armenia",
      0x042c => "Azeri - Azerbaijan (Latin)",
      0x082c => "Azeri - Azerbaijan (Cyrillic)",
      0x042d => "Basque - Spain",
      0x042f => "Macedonian - Macedonia",
      0x0436 => "Afrikaans - South Africa",
      0x0437 => "Georgian - Georgia",
      0x0438 => "Faeroese - Faeroe Islands",
      0x0439 => "Hindi - India",
      0x043e => "Malay - Malaysia",
      0x083e => "Malay - Brunei Darussalam",
      0x043f => "Kazak - Kazakstan",
      0x0441 => "Swahili - Kenya",
      0x0443 => "Uzbek - Uzbekistan (Latin)",
      0x0843 => "Uzbek - Uzbekistan (Cyrillic)",
      0x0444 => "Tatar - Tatarstan",
      0x0445 => "Bengali - India",
      0x0446 => "Punjabi - India",
      0x0447 => "Gujarati - India",
      0x0448 => "Oriya - India",
      0x0449 => "Tamil - India",
      0x044a => "Telugu - India",
      0x044b => "Kannada - India",
      0x044c => "Malayalam - India",
      0x044d => "Assamese - India",
      0x044e => "Marathi - India",
      0x044f => "Sanskrit - India",
      0x0457 => "Konkani - India" );

sub language {
    my $self = shift;
    if ($self->{PLATFORMID} == 0) {
	return "unknown $self->{LANGUAGEID}";
    } elsif ($self->{PLATFORMID} == 1) {
	return $nameMacintoshLanguages{$self->{LANGUAGEID}}
	    if defined $nameMacintoshLanguages{$self->{LANGUAGEID}};
	return "unknown $self->{LANGUAGEID}";
    } elsif ($self->{PLATFORMID} == 2) {
	return "unknown $self->{LANGUAGEID}";
    } elsif ($self->{PLATFORMID} == 3) {
	return $nameMicrosoftLanguages{$self->{LANGUAGEID}}
	    if defined $nameMicrosoftLanguages{$self->{LANGUAGEID}};
	return "unknown $self->{LANGUAGEID}"
    } else {
	return "unknown $self->{LANGUAGEID}";
    }
}

# See http://www.microsoft.com/typography/OTSPEC/name.htm

my @nameDescriptions =
    ( "Copyright notice",
      "Font Family name",
      "Font Subfamily name",
      "Unique font identifier",
      "Full font name",
      "Version string",
      "Postscript name for the font",
      "Trademark",
      "Manufacturer Name",
      "Designer",
      "Description",
      "URL Vendor",
      "URL Designer",
      "License Description",
      "License Info URL",
      "Reserved",
      "Preferred Family (Windows only)",
      "Preferred Subfamily (Windows only)",
      "Compatible Full (Macintosh only)" );

sub namedesc {
    my $self = shift;
    return $nameDescriptions[$self->{NAMEDESCID}]
	if defined $nameDescriptions[$self->{NAMEDESCID}];
    return "unknown $self->{NAMEDESCID}"
}

my @nameLongDescriptions =
    ( "Copyright notice.",
      "Font Family name.",
      "Font Subfamily name; for purposes of definition, this is assumed to address style (italic, oblique) and weight (light, bold, black, etc.) only.  A font with no particular differences in weight or style (e.g. medium weight, not italic and fsSelection bit 6 set) should have the string \"Regular\" stored in this position.",
      "Unique font identifier.",
      "Full font name; this should simply be a combination of strings 1 and 2.  Exception: if string 2 is \"Regular\" as indicated in string 2, then use only the family name contained in string 1.  This is the font name that Windows will expose to users.",
      "Version string.  Must begin with the syntax 'Version n.nn ' (upper case, lower case, or mixed, with a space following the number).",
      "Postscript name for the font.",
      "Trademark; this is used to save any trademark notice/information for this font.  This is distinctly separate from the copyright.",
      "Manufacturer Name.",
      "Designer; name of the designer of the typeface.",
      "Description; description of the typeface. Can contain revision information, usage recommendations, history, features, etc.",
      "URL Vendor; URL of font vendor (with protocol, e.g., http://, ftp://).  If a unique serial number is embedded in the URL, it can be used to register the font.",
      "URL Designer; URL of typeface designer (with protocol, e.g., http://, ftp://).",
      "License Description;",
      "License Info URL;",
      "Reserved; Set to zero.",
      "Preferred Family (Windows only); In Windows, the Family name is displayed in the font menu; the Subfamily name is presented as the Style name.  For historical reasons, font families have contained a maximum of four styles, but font designers may group more than four fonts to a single family.  The Preferred Family and Preferred Subfamily IDs allow font designers to include the preferred family/subfamily groupings.  These IDs are only present if they are different from IDs 1 and 2.",
      "Preferred Subfamily (Windows only); In Windows, the Family name is displayed in the font menu; the Subfamily name is presented as the Style name.  For historical reasons, font families have contained a maximum of four styles, but font designers may group more than four fonts to a single family.  The Preferred Family and Preferred Subfamily IDs allow font designers to include the preferred family/subfamily groupings.  These IDs are only present if they are different from IDs 1 and 2.",
      "Compatible Full (Macintosh only); On the Macintosh, the menu name is constructed using the FOND resource.  This usually matches the Full Name.  If you want the name of the font to appear differently than the Full Name, you can insert the Compatible Full Name in ID 18." );

sub namedesc_long {
    my $self = shift;
    return $nameLongDescriptions[$self->{NAMEDESCID}]
	if defined $nameLongDescriptions[$self->{NAMEDESCID}];
    return "unknown $self->{NAMEDESCID}"
}

sub unicode2ascii {
    my $tmp = shift;
    my $string = undef;
    $tmp = $_ unless defined $tmp;
    foreach ($tmp =~ m,..,g) {
	my $b1;
	my $b2;
	($b1, $b2) = m,.,g;
	if (ord($b1) == 0) {
	    $b1 = '';
	} else {
	    $b1 = $b2 = '.';
	}
	$string .= $b1.$b2;
    }
    return $string;
}

sub string {
    my $self = shift;

    # Convert Unicode
    return unicode2ascii($self->{STRING})
	if $self->platform eq "Microsoft";
    return unicode2ascii($self->{STRING})
	if $self->platform eq "Apple"; # Apple Unicode
    
    return $self->{STRING};
}

package FreeTypeFace;

sub lookup_englishname {
    my $self = shift;
    my $index = $_[0];

    my $n = $self->namenum;
    return undef unless $n > 0;

    for (my $i = 0; $i < $n; $i++) {
	my $name = new FreeTypeName($self, $i);
	if ($name->namedescID == $index) {
	    # Try to find a Microsoft English Name
	    return $name 
		if ($name->platform eq "Microsoft" &&
		    ($name->encoding =~ /Undefined/ ||
		     $name->encoding =~ /Unicode/) &&
		    $name->language =~ /English/);
	}
    }

    # I divide name checking routine like this because dynafont has
    # Japanese string as "macintosh roman english" name.
    for (my $i = 0; $i < $n; $i++) {
	my $name = new FreeTypeName($self, $i);
	if ($name->namedescID == $index) {
	    # Try to find a Macintosh English Name
	    return $name
		if ($name->platform eq "Macintosh" &&
		    $name->language =~ /English/);
	}
    }

    return undef;
}

sub lookup_anyname {
    my $self = shift;
    my $index = $_[0];

    my $n = $self->namenum;
    return undef unless $n > 0;

    for (my $i = 0; $i < $n; $i++) {
	my $name = new FreeTypeName($self, $i);
	return $name if $name->namedescID == $index;
    }

    return undef;
}

sub lookup_allnamestring {
    my $self = shift;
    my $index = $_[0];

    my $n = $self->namenum;
    return undef unless $n > 0;

    my $namestring = "";
    for (my $i = 0; $i < $n; $i++) {
	my $name = new FreeTypeName($self, $i);
	$namestring .= $name->string . " "
	    if $name->namedescID == $index;
    }

    return $namestring;
}

package FreeTypeWrapper;

sub lookup_language {
    my $self = shift;
    my $language = $_[0];

    my $faces = $self->facenum;
    $faces = 1 unless $faces > 0;
    for (my $i = 0; $i < $faces; $i++) {
	my $face = $self->open_collection($i);
	my $names = $face->namenum;

	for (my $j = 0; $j < $names; $j++) {
	    my $name = new FreeTypeName($face, $j);
	    return $names if $name->language =~ /$language/;
	}
    }
    return undef;
}

1;