#!/usr/bin/perl
# $Id: starter_opentype.pl,v 1.1 2009/09/11 10:32:16 stm Exp $
# Starter sample for OpenType font features
#
# Demonstrate various typographic OpenType features after checking
# whether a particular feature is supported in a font.
#
# Required software: PDFlib/PDFlib+PDI/PPS 8
# Required data: suitable fonts with OpenType feature tables
#
# This sample uses a default font which includes a few features.
# For better results you should replace the default font with a suitable
# commercial font. Depending on the implementation of the features you
# may also have to replace the sample text below.
#
# Some ideas for suitable test fonts:
# Palatino Linotype: standard Windows font with many OpenType features

use pdflib_pl 8.0;
use strict;

# This is where the data files are. Adjust as necessary.
use constant searchpath => "../data";
use constant outfile => "starter_opentype.pdf";

use constant { 
    llx => 50.0,
    lly => 50.0,
    urx => 800.0,
    ury => 550.0
};

# This font will be used unless another one is specified in the table 
use constant defaulttestfont => "DejaVuSerif";

use constant headers => (
    "OpenType feature",
    "Option list",
    "Font name",
    "Raw input (feature disabled)",
    "Feature enabled"
);

# Key names used to make a dictionary for the description of the
# testcase entries
my @testcase_keys = qw(description fontname feature text);

# Function to create a hash describing each testcase
sub make_testcase_hash {
    my $values = $_[0]; # reference to array
    my %result;
    @result{@testcase_keys} = @{$values};
    return \%result;
}

# The testcases organized as an array of references to hashes
my @testcases = map { make_testcase_hash($_) } (
    [
      "ligatures",          # description
      "",                   # fontname
      "liga",               # feature
      "ff fi fl ffi ffl"    # text
    ],
    [
      "discretionary ligatures",
      "",
      "dlig",
      "st c/o"
    ],
    [
      "historical ligatures",
      "",
      "hlig",
      "&.longs;b &.longs;t"
    ],
    [
      "small capitals",
      "",
      "smcp",
      "PostScript"
    ],
    [
      "ordinals",
      "",
      "ordn",
      "1o 2a 3o"
    ],
    [
      "fractions",
      "",
      "frac",
      "1/2 1/4 3/4"
    ],
    [
      "alternate fractions",
      "",
      "afrc",
      "1/2 1/4 3/4"
    ],
    [
      "slashed zero",
      "",
      "zero",
      "0"
    ],
    [
      "historical forms",
      "",
      "hist",
      "s"
    ],
    [
      "proportional figures",
      "",
      "pnum",
      "0123456789"
    ],
    [
      "old-style figures",
      "",
      "onum",
      "0123456789"
    ],
    [
      "lining figures",
      "",
      "lnum",
      "0123456789"
    ],
    [
      "superscript",
      "",
      "sups",
      "0123456789"
    ]
);

my $p = PDF_new();

eval {
    my $optlist;

    PDF_set_parameter($p, "SearchPath", searchpath);
    PDF_set_parameter($p, "textformat", "bytes");
    PDF_set_parameter($p, "charref", "true");

    # This means that formatting and other errors will raise an
    # exception. This simplifies our sample code, but is not
    # recommended for production code.
    PDF_set_parameter($p, "errorpolicy", "exception");

    # Set an output path according to the name of the topic 
    if (PDF_begin_document($p, outfile, "") == -1) {
        printf("Error: %s\n", PDF_get_errmsg($p));
        PDF_delete($p);
        exit(2);
    }

    PDF_set_info($p, "Creator", "PDFlib starter sample");
    PDF_set_info($p, "Title", "starter_opentype");

    # Start Page 
    PDF_begin_page_ext($p, 0, 0, "width=a4.height height=a4.width");

    my $table = -1;

    # Table header 
    my $col = 1;
    foreach my $header (headers) {
        $optlist =
           "fittextline={fontname=Helvetica-Bold encoding=unicode fontsize=12} " .
           "margin=4";
        $table = PDF_add_table_cell($p, $table, $col, 1, $header, $optlist);
        $col += 1;
    }

    # Create a table with feature samples, one feature per table row 
    my $row = 2;
    foreach my $testcase (@testcases) {
        # Use the entry in the test table if available, and the
        # default test font otherwise. This way we can easily check
        # a font for all features, as well as insert suitable fonts
        # for individual features.
        my $testfont = 
            $testcase->{fontname} ? $testcase->{fontname} : defaulttestfont;

        $col = 1;

        # Common option list for columns 1-3 
        $optlist = 
            "fittextline={fontname=Helvetica encoding=unicode fontsize=12} " .
            "margin=4";

        # Column 1: feature description 
        $table = PDF_add_table_cell($p, $table, $col++, $row,
                                    $testcase->{description}, $optlist);

        # Column 2: option list 
        my $buf = sprintf "features={%s}", $testcase->{feature};
        $table = PDF_add_table_cell($p, $table, $col++, $row, $buf, $optlist);

        # Column 3: font name 
        $table = PDF_add_table_cell($p, $table, $col++, $row, $testfont,
                                    $optlist);

        # Column 4: raw input text with  feature disabled 
        $optlist = sprintf
             "fittextline={fontname={%s} encoding=unicode fontsize=12 " .
             "embedding} margin=4", $testfont;
        $table = PDF_add_table_cell($p, $table, $col++, $row,
                                    $testcase->{text}, $optlist);

        # Column 5: text with enabled feature, or warning if the
        # feature is not available in the font
        my $font = PDF_load_font($p, $testfont, "unicode", "embedding");

        # Check whether font contains the required feature table 
        $optlist = sprintf "name=%s", $testcase->{feature};
        if (PDF_info_font($p, $font, "feature", $optlist) == 1) {
            # feature is available: apply it to the text 
            $optlist = sprintf
                 "fittextline={fontname={%s} encoding=unicode fontsize=12 " .
                 "embedding features={%s}} margin=4",
                 $testfont, $testcase->{feature};
            $table = PDF_add_table_cell($p, $table, $col++, $row,
                                        $testcase->{text}, $optlist);
        }
        else {
            # feature is not available: emit a warning 
            $optlist = 
                 "fittextline={fontname=Helvetica encoding=unicode " .
                 "fontsize=12 fillcolor=red} margin=4";
            $table = PDF_add_table_cell($p, $table, $col++, $row,
                    "(feature not available in this font)", $optlist);
        }
        
        $row += 1;
    }

    # Place the table 
    $optlist = sprintf "header=1 fill={{area=rowodd " .
        "fillcolor={gray 0.9}}} stroke={{line=other}} ";
    my $result = PDF_fit_table($p, $table, llx, lly, urx, ury, $optlist);

    if ($result eq "_error") {
        printf("Couldn't place table: %s\n", PDF_get_errmsg($p));
        PDF_delete($p);
        exit(2);
    }

    PDF_end_page_ext($p, "");
    PDF_end_document($p, "");
};

if ($@) {
    printf("$0: PDFlib Exception occurred:\n");
    printf(" $@\n");
    exit(1);
}
