view release on metacpan or  search on metacpan

Examples/ttfenc.pl  view on Meta::CPAN

    binmode OUTFILE;                # need Unix file format!
    select OUTFILE;
    
    print "/TeXBase1Encoding [\n";
    
    for ($i = 0; $i < 256; $i++)
    {
        my ($name, $gid);
        
        printf "%% 0x%02X\n", $i unless ($i & 15);
        $gid = $font->{'cmap'}->ms_lookup($map->[$i]);
        $name = $font->{'post'}{'VAL'}[$gid];
        $name = $texCorrect{$name} if ($opt_x && defined $texCorrect{$name});
        while ($font->{'post'}{'STRINGS'}{$name} != 0 && $font->{'post'}{'STRINGS'}{$name} != $gid)
        {
            print STDERR "multiple occurrences of $name. Use -o to fix font\n" unless ($opt_o);
            $name =~ s/([0-9])*$/$1 + 1/oe;
        }
        $mypost->[$gid] = $name;
        print "    /$name";
        print "\n" if ($i & 3) == 3;
    }
    
    print "] def\n";
    
    select STDOUT;
    close (OUTFILE);
}

if ($opt_o)
{
    $font->{'post'}{'VAL'} = $mypost;
    $font->out($opt_o) || warn "Can't write font to $opt_o";
}

if ($opt_d)
{
    open(OUTFILE, ">$opt_d") || die "Unable to open $opt_d";
    select OUTFILE;
    
    $font->{'hmtx'}->read;
    print <<'EOT';
\def\basechar#1{\nobreak\hskip 0pt plus .05em minus .003em \char#1 \relax}
\catcode1=\active
\def^^A{}
EOT
    print "\\def\\$psname\{" . '%' . "\n\%\\frenchspacing\n";
    $min = 128;
    $min = 32 if ($opt_z & 1);
        
    for ($i = $min; $i < 256; $i++)
    {
        next unless ($map->[$i]);
        next if (($opt_z & 2) && pack('C', $i) =~ m/[0-9\-:]/o);
        my ($gid) = $font->{'cmap'}->ms_lookup($map->[$i]);
        my ($lsb, $adv) = ($font->{'hmtx'}{'lsb'}[$gid], $font->{'hmtx'}{'advance'}[$gid]);
        
        if (-$lsb <= $adv && $lsb != 0)
        { 
#            printf "\\catcode%d=\\active\\uccode1=%d \\uppercase{\\xdef^^A{\\noexpand\\basechar{%s}}}%%\n", $i, $i, chr($i);
#            printf "\\catcode%d=\\active\\uccode1=%d \\expandafter\\gdef\\uppercase{^^A}{\\basechar{%s}}%%\n", $i, $i, chr($i);
            printf "\\catcode%d=\\active\\uccode1=%d \\uppercase{\\edef^^A{\\noexpand\\basechar{%d}}}%%\n", $i, $i, $i;
            push (@list, $i);
        }
    }
    print "}\n";
    
    print "\\def\\un$psname\{".'%'."\n";
    foreach (@list)
    { 
        if ($texcatcodes{chr($_)})
        { print "\\catcode$_=" . $texcatcodes{chr($_)} . '%' . "\n"; }
        else
        { print "\\catcode$_=12".'%'."\n"; }
    }
    print "}\n";
    print <<'EOT';
\catcode1=12
EOT
    
    select STDOUT;
    close(OUTFILE);
}

exit unless defined $opt_t;

$tfmname = $opt_t;
$tfmname =~ s/(.*[\\\/])?(.*)\.tfm/$2/oi;
$encname = $opt_e;
$encname =~ s/(.*[\\\/])?(.*)\.enc/$2/oi;

if (0)
{
    system("ttf2afm -e $opt_e -o $tfmname.afm $ARGV[0] > $base.log");
    open(INFILE, "afm2tfm $tfmname.afm |") || die "Can't run afm2tfm";
    $mapline = <INFILE>;
    close(INFILE);
    (undef, $psname) = split(' ', $mapline);
    if ($opt_t !~ /^$tfmname\.tfm/i)
    {
        open (INFILE, "$tfmname.tfm") || die "Can't open $tfmname.tfm";
        binmode INFILE;
        unlink ("$opt_t") || goto getout;
        open (OUTFILE, ">$opt_t") || goto doneit;
        binmode OUTFILE;
        while (read(INFILE, $dat, 4096))
        { print OUTFILE $dat; }
        close (OUTFILE);
    doneit:
        close (INFILE);
    }
}
else
{
    make_tfm($font, $map, $psname, $opt_t);
}

if (defined $opt_p)
{
    open(OUTFILE, ">>$opt_p") || die "Can't open $opt_p for appending";
    print OUTFILE "$tfmname $psname <$base.ttf $encname.enc\n";