#! /usr/bin/perl
'di ';
'ds 00 \"';
'ig 00 ';
#
# This is a dumper of TrueType font by using FreeType library.
$rcsid = q$Id: ftinfo.pl,v 1.16 1998/12/14 05:12:08 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 FreeTypeWrapper;
use Jcode;
use Getopt::Std;

my %opts;
getopts('daclhinopMm:s:', \%opts);

die "Usage: $0 [-daclhinopM] [-m char] [-s scale (point)] font-names...
  -d: debug mode
  -a: dump all
  -c: dump charmap
  -l: dump list of properties
  -h: dump all header
  -i: dump all horizontal header
  -n: dump all names
  -o: dump all os/2
  -p: dump all postscript
  -M: dump metrics of instance
  -m char: dump metrics of character
  -m perl-exp: dump each metrics of characters, e.g. -m '\"a\"..\"z\"'
  -s point: scale glyph into # point
" unless @ARGV;

@opts{qw(c l h i n o p)} = (1) x 7 if $opts{a};
$opts{'s'} = 10 unless defined $opts{'s'};

foreach $fn (@ARGV) {
    my $font = new FreeTypeWrapper($fn);
    warn "open failed: $fn\n" and next
      unless defined $font;
    for ($i = 0; $i < $font->facenum; $i++) {
	my $face = $font->open_collection($i);
	warn "open_collection failed: $fn\n" and next
	  unless defined $face;

	my $count = $face->namenum;
	my $prop = $face->TT_Get_Face_Properties();

	print "$fn: $i face\n";

	if ($opts{'c'}) {
	    my $charmapnum = $face->charmapnum;
	    for (my $j = 0; $j < $charmapnum; $j++) {
		my $charmap = new FreeTypeCharMap($face, $j);

		if (!defined $charmap) {
		    printf("$fn: $i: $j charmap: NONE\n");
		    next;
		}
		printf("$fn: $i: $j charmap: platformID=%d encoding=%d\n",
		       $charmap->platformID, $charmap->encodingID) if $opts{'d'};
		printf("$fn: $i: $j charmap: %s, %s\n",
		       $charmap->platform, $charmap->encoding) unless $opts{'d'};
	    }
	}

	if ($opts{'l'}) {
	    foreach $j (sort (keys %{$prop})) {
		print "$fn: $i: $j: $prop->{$j}\n";
	    }
	}

	if ($opts{'h'}) {
	    foreach $j (sort (keys %{$prop->{header}})) {
		print "$fn: $i: header: $j: $prop->{header}->{$j}\n";
	    }
	}

	if ($opts{'i'}) {
	    foreach $j (sort (keys %{$prop->{horizontal}})) {
		print "$fn: $i: horizontal: $j: $prop->{horizontal}->{$j}\n";
	    }
	}

	if ($opts{'n'}) {
	    for ($j = 0; $j < $count; $j++) {
		my $name = new FreeTypeName($face, $j);
		my $string = $name->string();

		Jcode::convert(*string, 'euc', 'sjis');
		printf("$fn: $i: $j name: platformID=%d encoding=%d languageID=%d nameID=%d, name=\"%s\"\n",
		       $name->platformID, $name->encodingID, $name->languageID,
		       $name->namedescID, $string) if $opts{'d'};
		printf("$fn: $i: $j name: %s, %s, %s, %s: %s\n",
		       $name->platform, $name->encoding, $name->language,
		       $name->namedesc, $string) unless $opts{'d'};
	    }
	}

	if ($opts{'o'}) {
	    print("$fn: $i: os2: code page range: ",
		  $face->get_codepagerange, "\n");
	    print("$fn: $i: os2: unicode range: ",
		  $face->get_unicoderange, "\n");
	    printf("$fn: $i: os2: xAvgCharWidth = %d\n",
		  $prop->{os2}->{xAvgCharWidth});
	    print("$fn: $i: os2: usWeightClass: ",
		  $face->get_weightclass, "\n");
	    print("$fn: $i: os2: usWidthClass : ",
		  $face->get_widthclass, "\n");
	    print("$fn: $i: os2: fsSelection : ",
		  $face->get_selection, "\n");

	    foreach $j (sort (keys %{$prop->{os2}})) {
		if ($j eq "panose") {
		    ($a = $prop->{os2}->{$j}) =~
			s/(.)/sprintf("0x%02x ", ord($1))/ge;
		    print "$fn: $i: os2: $j: $a\n";
		} elsif ($j eq "achVendID") {
		    ($a = $prop->{os2}->{$j}) =~ s/(\s|\0)*$//;
		    print "$fn: $i: os2: $j: $a\n";
		} else {
		    print "$fn: $i: os2: $j: $prop->{os2}->{$j}\n";
		}
	    }
	}

	if ($opts{'p'}) {
	    foreach $j (sort (keys %{$prop->{postscript}})) {
		print "$fn: $i: postscript: $j: $prop->{postscript}->{$j}\n";
	    }
	}

	if ($opts{'M'}) {
	    my $charmapnum = $face->charmapnum;
	    my $charmap;
	    my $j;
	    for ($j = 0; $j < $charmapnum; $j++) {
		$charmap = new FreeTypeCharMap($face, $j);
		last if $charmap->platform =~ /Microsoft/ &&
		    $charmap->encoding =~ /Unicode/;
	    }
	    die "Cannot find Microsoft Unicode character map\n"
		if $j == $charmapnum;

	    my $instance = $face->new_instance();
	    $instance->set_resolutions(100, 100);
	    $instance->set_flags(1, 1);
	    $instance->set_charsize($opts{'s'} * 64);
	    my $metrics = $instance->metrics();
	    foreach $mval (sort (keys %{$metrics})) {
		printf("$fn: $i: Instance Metrics: %s -> %s\n",
		       $mval, $metrics->{$mval});
	    }
	}

	if ($opts{'m'}) {
	    my $charmapnum = $face->charmapnum;
	    my $charmap;
	    my $j;
	    for ($j = 0; $j < $charmapnum; $j++) {
		$charmap = new FreeTypeCharMap($face, $j);
		last if $charmap->platform =~ /Microsoft/ &&
		    $charmap->encoding =~ /Unicode/;
	    }
	    die "Cannot find Microsoft Unicode character map\n"
		if $j == $charmapnum;

	    my $instance = $face->new_instance();
	    $instance->set_resolutions(100, 100);
	    $instance->set_flags(1, 1);
	    $instance->set_charsize($opts{'s'} * 64);

	    $opts{'m'} = "\"$opts{'m'}\"" if length $opts{'m'} == 1;
	    foreach $val (eval $opts{'m'}) {
		$val = ord($val) if $val !~ /^\d/;
		$val = oct($val) if $val =~ /^0/;
		my $code = $charmap->convert($val);
		printf("$fn: $i: char 0x%x: converted into 0x%x, %d " .
		       "pt scaled\n", $val, $code, $opts{'s'});

		my $g = new FreeTypeGlyph($instance, $code);
		my $metrics = $g->metrics();
		printf("$fn: $i: char 0x%x: Metrics: aw %d -> %g, " .
		       "bX %d -> %g, bY %d -> %g\n",
		       $val,
		       $metrics->{advance},
		       $metrics->{advance} / 64,
		       $metrics->{bearingX},
		       $metrics->{bearingX} / 64,
		       $metrics->{bearingY},
		       $metrics->{bearingY} / 64);
#		foreach $mval (sort (keys %{$metrics})) {
#		    printf("$fn: $i: char 0x%x: Metrics: %s -> %s\n",
#			   $val, $mval, $metrics->{$mval});
#		}

		my $outline = $g->outline();
#		$outline->{OUTLINE}->{dropout_mode} = 2;

		my %matrix =
		    ( "xx" => 180 / 180 * 65536,
		      "xy" => 0,
		      "yx" => 0,
		      "yy" => 180 / 180 * 65536 );
		$outline->transform(\%matrix);

		$bbox = $outline->get_bbox();
		printf("$fn: $i: char 0x%x: BBox is (%d, %d), (%d, %d) -> " .
		       "(%g, %g), (%g, %g)\n",
		       $val,
		       $bbox->{xMin}, $bbox->{yMin}, 
		       $bbox->{xMax}, $bbox->{yMax},
		       $bbox->{xMin} / 64, $bbox->{yMin} / 64, 
		       $bbox->{xMax} / 64, $bbox->{yMax} / 64);
	    }
	}
    }
}
##############################################################################

	# These next few lines are legal in both Perl and nroff.

			# finish .ig
.00 ;

'di			\" finish diversion--previous line must be blank
.nr nl 0-1		\" fake up transition to first page again
.nr % 0			\" start at page 1
';<<'.ex'; #__END__ ############# From here on it's a standard manual page ############
.TH FTINFO 1 "May 10, 1998"
.AT 3
.SH NAME
ftinfo \- display FreeType information of TrueType font files.
.SH SYNOPSIS
.B ftinfo [-daclhinop] [-mchar] [-sscale] font-names ...
.SH DESCRIPTION
.I Ftinfo
displays information of each font file by using FreeType library.
.sp
.SH OPTIONS
.IP -d
Enter debug mode.
.IP -a
Dump all information about each TrueType font file.
.IP -c
Dump charmap information.
.IP -l
Dump list of properties.
.IP -h
Dump all information in header property.
.IP -i
Dump all information in horizontal header property.
.IP -n
Dump all information in name property.
.IP -o
Dump all information in os/2 property.
.IP -p
Dump all information in postscript property.
.IP -m\fIchar\fP
Calculate and show the metrics of a character.
.IP -m\fIperl-exp\fP
Calculate and show the each metrics of a characters represented by perl-exp,
e.g. -m '"a".."z"' show all metrics from a to z.
.IP -s\fIscale\fP
Use scale as point-size of calculation of the metrics.
.SH COPYRIGHT
Copyright (c) 1998  Kazushi (Jam) Marukawa
.br
Comments to: jam@pobox.com
.ex