view release on metacpan or  search on metacpan

Examples/addpclt.pl  view on Meta::CPAN

#! /usr/bin/perl

#   Title:          ADDPCLT.BAT
#   Author:         M. Hosken
#   Description:
# 1.0.0 MJPH    18-MAR-1998     Original

require 'ttfmod.pl';
use Getopt::Std;
do getopts("d:z");

$[ = 0;
if ((defined $opt_d && !defined $ARGV[0]) || (!defined $opt_d && !defined $ARGV[1]))
    {
    die 'ADDPCLT [-d directory] [-z] <infile> <outfile>

v1.0.0, 18-Mar-1998  (c) Martin_Hosken@sil.org

Adds a PCLT table to a font which does not have one. Much of the information is
guesswork or made up from investigation made in the font.
    -d      specifies output directory for processing multiple files. In which
            case <outfile> is not used and <infile> may be a list including
            wildcards.
    -z      debug
';
}

$old = select(STDERR); $| = 1; select($old);

$fns{"PCLT"} = "make_pclt";

if (defined $opt_d)
    {
    foreach $f (@ARGV)
        {
        print STDERR "$f -> $opt_d/$f\n" unless (defined $opt_q);
        &ttfmod($f, "$opt_d/$f", *fns);
        }
    }
else
    {
    &ttfmod($ARGV[0], $ARGV[1], *fns, "PCLT");
    }

sub make_pclt
{
    local(*INFILE, *OUTFILE, $len) = @_;
    local($csum);

    return (&ttfmod'copytab(*INFILE, *OUTFILE, $len)) if ($len != 0);

    $len = 54;
    $inf[0] = 1 << 16;      # version 1
    $inf[1] = 1 << 31;      # fontnumber (derived)
    $inf[4] = 0;            # black normal uncondensed
    $inf[5] = 6 << 12;      # derived font
    $inf[7] = 629;          # symbol set Win3.1
    $inf[8] = " " x 16;    
    $inf[9] = -1;
    $inf[10] = 0x37FFFFFE;   # character complement Windows ANSI
    $inf[12] = 0;           # normal stroke weight
    $inf[13] = 0;           # normal widthType
    $inf[14] = 0;           # normal serif style
    $inf[15] = 0;           # reserved

# Now for the tricky stuff!
# Get some glyph ids
    $off = (split(':', $ttfmod'dir{'post'}))[2];
    seek(INFILE, $off, 0);                          # go to post table
    printf "%s @ %x\n", "post", $off if defined $opt_z;
    read(INFILE, $tdat, 4);                         # get format
    ($tmaj, $tmin) = unpack("n2", $tdat);