#! /usr/bin/perl
#   Title:      TTFNAME.BAT
#   Author:     M. Hosken
#   Description: Change the family name of a font, thus changing full font
#                name.
#   Requirement: PERL 4 or PERL 5. TTFMOD.PL should come with this.
#
# 1.1   MJPH    20-MAR-1998     Add -l, -s

require 'ttfmod.pl';
require 'getopts.pl';
do Getopts("f:l:n:qs:t:");


if (!defined $ARGV[1] || !defined $opt_n)
    {
    die 'TTFNAME [-f "new_full_name"] -n "new_name" [-t num] [-q] <infile> <outfile>

v1.1.0, 20-Mar-1998  (c) Martin_Hosken@sil.org

    Renames the TTF with the given name and outputs the newly named font to
<outfile>.
        -f "name"   specifies new full name (optional) as opposed to the
                    default calculated form.
        -l lang     language number to use (default all langs)
        -n "name"   specifies new font family name (not optional)
        -q          disable signon message
        -s filename overrides -n and gets string from file. Useful for -t
        -t num      overrides the normal naming areas to change another
                    string -f becomes inactive.
';
    }

if (defined $opt_s)
{
    open(INFILE, "$opt_s") || die "Unable to open $opt_s";
    $opt_n = join('', <INFILE>);
    $opt_n =~ s/\n/ /oig;
}

print "TTFNAME v1.1: Freeware, (c) M. Hosken\n" if (!defined $opt_q);

$fns{"name"} = "do_name";
&ttfmod($ARGV[0], $ARGV[1], *fns);
# that's all folks!!

# called to process "name" table
sub do_name {
    local(*INFILE, *OUTFILE, $len) = @_;
    local($csum);

    # copy and checksum table header
    read(INFILE, $name_head, 6) || die "Unable to read name table header";
    ($name_num) = unpack("x2n", $name_head);
    print OUTFILE $name_head;
    $csum = unpack("%32N", $name_head);
        # not 4 byte boundary - grrr!
    $csum += unpack("%32N", substr($name_head, 4, 2) . "\0\0");
    if ($csum > 0xffffffff) { $csum -= 0xffffffff; $csum -= 1; }

    # read name directory and calculate string space
    $str_tot = 0;
    for ($i = 0; $i < $name_num; $i++)
        {
        read(INFILE, $name_dir, 12) || die "Unable to read name entry";
        $names[$i] = $name_dir;
        ($name_id, $str_len, $str_off) = unpack("x6n3", $name_dir);
        $str_tot = $str_off + $str_len if ($str_off + $str_len > $str_tot);
        $ids[$name_id] .= "$i:";
        }
    foreach (@ids)
        { chop; }                   # chop trailing ':' from index list
    read(INFILE, $str, $str_tot) || die "Unable to glob all name strings";
    # copy strings or hijack them to new string space
    $spos = 0;
    for ($i = 0; $i < $name_num; $i++)
        {
        ($id_p, $id_e, $id_l, $name_id, $str_len, $str_off)
                = unpack("n6", $names[$i]);
        if (!defined $opt_t && ($name_id == 1 || $name_id == 4)     # family or full name
                    && !(defined $opt_l && $opt_l == $id_l))
            {
            if ($name_id == 4 && !defined $opt_f)   # calculate full name?
                {
                subfamily:                      # find subfamily name
                foreach $id (split(':', $ids[2]))
                    {
                    ($iid_p, $iid_e, $iid_l, $iid_n, $ilen, $ioff)
                                = unpack("n6", $names[$id]);
                    if ($id_p == $iid_p && $id_e == $iid_e && $id_l == $iid_l)
                        {
                        $tstr = substr($str, $ioff, $ilen);
                        $temp = $tstr;
                        $temp =~ s/\0//ogi;
                        $tstr = "" if ($temp =~ m/^regular$/oi
                                || $temp =~ m/^normal$/oi
                                || $temp =~ m/^standard$/oi);
                        $tlen = length($tstr);
                        last subfamily;
                        }
                    }
                }
            else                    # nothing to add to family name
                {
                $tstr = "";
                $tlen = 0;
                }
            if ($id_p == 0 || $id_p == 3 || ($id_p == 2 && $id_e == 1))
                {                               # 16 bit character set
                if ($name_id == 4 && defined $opt_f)    # special full name?
                    {
                    $outstr .= "\0" . join("\0", split('', $opt_f));
                    $str_len = 2 * length($opt_f);
                    }
                else                            # make new 16 bit string
                    {
                    $outstr .= "\0" . join("\0",
                        split('', $opt_n . (($tstr eq "") ? "" : " "))) . $tstr;
                    $str_len = 2 * length($opt_n) + $tlen
                                + ($tstr eq "" ? 0 : 2);
                    }
                }                                       # else 8 bit
            elsif ($name_id == 4 && defined $opt_f)     # special full name?
                {
                $outstr .= $opt_f;
                $str_len = length($opt_f);
                }
            else                                        # hijack 8 bit name
                {
                $outstr .= $opt_n . ($tstr eq "" ? "" : " ") . $tstr;
                $str_len = length($opt_n) + $tlen + ($tstr eq "" ? 0 : 1);
                }
            }
        elsif (defined $opt_t && $opt_t == $name_id && !(defined $opt_l && $opt_l == $id_l))
            {
            if ($id_p == 0 || $id_p == 3 || ($id_p == 2 && $id_e == 1))
                {
                $outstr .= "\0" . join("\0", split('', $opt_n));
                $str_len = 2 * length($opt_n);
                }
            else
                {
                $outstr .= $opt_n;
                $str_len = length($opt_n);
                }
            }
        else                    # no hijacking, just copy from string space
            {
            $tstr = substr($str, $str_off, $str_len);
            $outstr .= $tstr;
            $str_len = length($tstr);
            }
        $str_off = $spos;       # this string offset
        $spos += $str_len;      # next string offset
        $outpre = pack("n", $id_p);     # handle 2 byte offset in checksums
        $outval = pack("n5", $id_e, $id_l, $name_id, $str_len, $str_off);
        print OUTFILE $outpre . $outval;    # output new directory entry
        $csum += unpack("%32N", "\0\0" . $outpre);      # checksum
        if ($csum > 0xffffffff) { $csum -= 0xffffffff; $csum -= 1; }
        $csum += unpack("%32N*", $outval . "\0\0");
        if ($csum > 0xffffffff) { $csum -= 0xffffffff; $csum -= 1; }
        }
    $outstr .= "\0" x (2, 1, 0, 3)[$spos & 3];      # pad string space
    $csum += unpack("%32N", "\0\0" . substr($outstr, 0, 2));    # checksum
    if ($csum > 0xffffffff) { $csum -= 0xffffffff; $csum -= 1; }
    $csum += unpack("%32N*", substr($outstr, 2));
    if ($csum > 0xffffffff) { $csum -= 0xffffffff; $csum -= 1; }
    print OUTFILE $outstr;                          # output string space

    ($spos + $name_num * 12 + 6, $csum);            # return length, checksum
    }

__END__

=head1 TITLE

ttfname - renames font files

=head1 SYNOPSIS

  TTFNAME [-f "new_full_name"] -n "new_name" [-t num] [-q] <infile> <outfile>
Renames the TTF with the given name and outputs the newly named font to
<outfile>.

=head1 OPTIONS

  -f "name"   specifies new full name (optional) as opposed to the
              default calculated form.
  -l lang     language number to use (default all langs)
  -n "name"   specifies new font family name (not optional)
  -q          disable signon message
  -s filename overrides -n and gets string from file. Useful for -t
  -t num      overrides the normal naming areas to change another
              string -f becomes inactive.
=cut

@REM=('
:end
@echo off
@REM ') if 0 ;