#!/usr/bin/perl
# $Id: glyphinfo.pl,v 1.8 2010/07/15 10:34:12 rjs Exp $
#
# Simple PDF glyph dumper based on PDFlib TET
#

use PDFlib::TET 4.0;
use strict;

# TET_char_info character types with real geometry info.
use constant TET_CT__REAL	=> 0;
use constant TET_CT_NORMAL	=> 0;
use constant TET_CT_SEQ_START	=> 1;

# TET_char_info character types with artificial geometry info.
use constant TET_CT__ARTIFICIAL	=> 10;
use constant TET_CT_SEQ_CONT	=> 10;
use constant TET_CT_INSERTED	=> 12;


# TET_char_info text rendering modes.
use constant TET_TR_FILL	=> 0;	# fill text
use constant TET_TR_STROKE	=> 1;	# stroke text (outline)
use constant TET_TR_FILLSTROKE	=> 2;	# fill and stroke text
use constant TET_TR_INVISIBLE	=> 3;	# invisible text
use constant TET_TR_FILL_CLIP	=> 4;	# fill text and
                                        # add it to the clipping path
use constant TET_TR_STROKE_CLIP	=> 5;	# stroke text and
                                        #  add it to the clipping path
use constant TET_TR_FILLSTROKE_CLIP=> 6;# fill and stroke text and
                                        #  add it to the clipping path
use constant TET_TR_CLIP	=> 7;	# add text to the clipping path

# TET_char_info attributes
use constant TET_ATTR_NONE      => 0x00000000;
use constant TET_ATTR_SUB       => 0x00000001;	# subscript
use constant TET_ATTR_SUP       => 0x00000002;	# superscript
use constant TET_ATTR_DROPCAP   => 0x00000004;	# initial large letter
use constant TET_ATTR_SHADOW    => 0x00000008;	# shadowed text
# character before hyphenation
use constant TET_ATTR_DEHYPHENATION_PRE       => 0x00000010;
# hyphenation artifact, i.e. the dash
use constant TET_ATTR_DEHYPHENATION_ARTIFACT  => 0x00000020;
# character after hyphenation
use constant TET_ATTR_DEHYPHENATION_POST      => 0x00000040;


# global option list
my $globaloptlist = "searchpath={{../data} {../../../resource/cmap}}";

# document-specific option list
my $docoptlist = "";

# page-specific option list
my $pageoptlist = "granularity=word";

my $pageno = 0;

eval  {
    my $tet;

    if ($#ARGV !=1) {
	die("usage: glyphinfo.pl <infilename> <outfilename>\n");
    }


    $tet = new PDFlib::TET;

    open(OUTFP, "> $ARGV[1]") ||
	die("Couldn't open output file '" . $ARGV[1] . "'\n");

    my $n_pages;
    my $doc;

    $tet->set_option($globaloptlist);

    $doc = $tet->open_document($ARGV[0], $docoptlist);

    if ($doc == -1) {
	die("Error ". $tet->get_errnum() . " in " . $tet->get_apiname()
	    . "(): " . $tet->get_errmsg() . "\n");
    }

    # get number of pages in the document
    $n_pages = $tet->pcos_get_number($doc, "length:pages");

    # Write UTF-8 BOM
    printf OUTFP "%c%c%c\n", 0xef, 0xbb, 0xbf;

    # loop over pages in the document
    for ($pageno = 1; $pageno <= $n_pages; ++$pageno)
    {
	my $text;
	my $page;
	my $len;

	$page = $tet->open_page($doc, $pageno, $pageoptlist);

	if ($page == -1) {
	    print("Error ". $tet->get_errnum() ." in ". $tet->get_apiname()
		. "(): " . $tet->get_errmsg() . "\n");
	    next;                        # try next page
	}

	# Administrative information
	printf OUTFP "[ Document: '%s' ]\n",
	    $tet->pcos_get_string($doc, "filename");

	printf OUTFP "[ Document options: '%s' ]\n",
	    $docoptlist;

	printf OUTFP "[ Page options: '%s' ]\n",
	    $pageoptlist;

	printf OUTFP "[ ----- Page %d ----- ]\n", $pageno;


	# Retrieve all text fragments
	while (defined($text = $tet->get_text($page)))
	{
	    my $ci;

	    printf OUTFP "[%s]\n", $text;  # print the retrieved text


	    # Loop over all glyphs and print their details
	    while ($ci = $tet->get_char_info($page))
	    {
		my $fontname;

		# Fetch the font name with pCOS (based on its ID)
		$fontname = $tet->pcos_get_string($doc,
			"fonts[" . $ci->{"fontid"} . "]/name");


		# Print the character
		printf OUTFP "U+%04X", $ci->{"uv"};

		# ...and its ASCII representation if appropriate
		if ($ci->{"uv"} >= 0x20 && $ci->{"uv"} <= 0x7F) {
		    printf OUTFP " '%c'", $ci->{"uv"};
		}

		# Print font name, size, and position
		printf OUTFP " %s size=%.2f x=%.2f y=%.2f",
		    $fontname, $ci->{"fontsize"}, $ci->{"x"}, $ci->{"y"};

		# Examine the "type" member
		if ($ci->{"type"} == TET_CT_SEQ_START) {
		    printf OUTFP " ligature_start";
		}
		elsif ($ci->{"type"} == TET_CT_SEQ_CONT) {
		    printf OUTFP " ligature_cont";
		}

		# Separators are only inserted for granularity > word
		elsif ($ci->{"type"} == TET_CT_INSERTED) {
		    printf OUTFP " inserted";
		}

		# Examine the bit flags in the "attributes" member
		if ($ci->{"attributes"} != TET_ATTR_NONE)
		{
		    if ($ci->{"attributes"} & TET_ATTR_SUB) {
			printf OUTFP "/sub";
		    }
		    if ($ci->{"attributes"} & TET_ATTR_SUP) {
			printf OUTFP "/sup";
		    }
		    if ($ci->{"attributes"} & TET_ATTR_DROPCAP) {
			printf OUTFP "/dropcap";
		    }
		    if ($ci->{"attributes"} & TET_ATTR_SHADOW) {
			printf OUTFP "/shadow";
		    }
		    if ($ci->{"attributes"} & TET_ATTR_DEHYPHENATION_PRE) {
			printf OUTFP "/dehyphenation_pre";
		    }
		    if ($ci->{"attributes"} & TET_ATTR_DEHYPHENATION_ARTIFACT) {
			printf OUTFP "/dehyphenation_artifact";
		    }
		    if ($ci->{"attributes"} & TET_ATTR_DEHYPHENATION_POST) {
			printf OUTFP "/dehyphenation_post";
		    }
		}

		printf OUTFP "\n";
	    }

	    printf OUTFP "\n";
	}

	if ($tet->get_errnum() != 0) {
	    print("Error ". $tet->get_errnum() . " in " . 
		    $tet->get_apiname() . "(): on page $pageno" 
		    . $tet->get_errmsg() . "\n");
	}

	$tet->close_page($page);
    }

    $tet->close_document($doc);
};

if ($@) {
    printf("PDFlib TET Exception occurred:\n");
    if ($pageno == 0) {
	printf("Error $@\n");
    } else {
	printf("Error $@ on page $pageno\n");
    }
    exit;
}
