#!/usr/bin/perl
# $Id: starter_opentype.pl,v 1.2 2009/11/23 14:31:30 rjs 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::PDFlib 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 = new PDFlib::PDFlib;

eval {
    my $optlist;

    $p->set_parameter("SearchPath", searchpath);
    $p->set_parameter("textformat", "bytes");
    $p->set_parameter("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.
    $p->set_parameter("errorpolicy", "exception");

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

    $p->set_info("Creator", "PDFlib starter sample");
    $p->set_info("Title", "starter_opentype");

    # Start Page 
    $p->begin_page_ext(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 = $p->add_table_cell($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 = $p->add_table_cell($table, $col++, $row,
                                    $testcase->{description}, $optlist);

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

        # Column 3: font name 
        $table = $p->add_table_cell($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 = $p->add_table_cell($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 = $p->load_font($testfont, "unicode", "embedding");

        # Check whether font contains the required feature table 
        $optlist = sprintf "name=%s", $testcase->{feature};
        if ($p->info_font($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 = $p->add_table_cell($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 = $p->add_table_cell($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 = $p->fit_table($table, llx, lly, urx, ury, $optlist);

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

    $p->end_page_ext("");
    $p->end_document("");
};

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