#! /usr/bin/perl -w
#
# This script creates proper entries for an FDX file as used by the
# CJK package for LaTeX.
#
# As a prerequisite, it needs the file `aglfn13.txt', available from
#
#   http://partners.adobe.com/asn/developer/typeforum/unicodegn.html
#
# Call the script as
#
#   perl makefdx.pl vertref_afm_file sfd_file fdx_file
#
# `vertref_afm_file' is an AFM file as produced by the script `vertref.pe'.
# `sfd_file' gives the subfont scheme to get the proper entries in
# `fdx_file'.
#
# Note that the created FDX file has to be completed manually.
#
# Example:
#
#   perl makefdx.pl bsmiuv.afm bsmiuvr.afm UBig5.sfd c00bsmi.fdx

use strict;

my $prog = $0;
$prog =~ s@.*/@@;

if ($#ARGV != 2) {
  die("usage: $prog vertref_afm_file sfd_file fdx_file\n");
}

my $vertrefafmfile = $ARGV[0];
my $sfdfile = $ARGV[1];
my $fdxfile = $ARGV[2];


# Read AGL file.

my %agl;

read_aglfile("aglfn13.txt", \%agl);


# Read AFM file.

my @vertref;

read_afmfile($vertrefafmfile, \@vertref);


# Read subfont definition file.

my @sfd;

read_sfdfile($sfdfile, \@sfd);


# Write FDX file.

print("Writing extended font definition file \`$fdxfile'...\n");

open(FDX, ">", $fdxfile)
|| die("$prog: can't open \`$fdxfile': $!\n");
my $oldfh = select(FDX);

foreach my $index (0 .. ($#vertref - 1)) {
  my $glyphnameref = $vertref[$index];
  my $unicode;

  if (defined ($agl{$glyphnameref})) {
    $unicode = $agl{$glyphnameref};
  }
  elsif ($glyphnameref =~ /^uni([0-9A-F]{4})$/) {
    $unicode = hex($1);
  }
  elsif ($glyphnameref =~ /^u([0-9A-F]{4,6})$/) {
    $unicode = hex($1);
  }
  else {
    $unicode = -1;
  }
  if ($unicode == -1
      || ($unicode >= 0xD800 && $unicode <= 0xDFFF)
      || $unicode > 0x10FFFF) {
    print(STDERR "Can't map glyph name \`$glyphnameref' to Unicode.\n");
    next;
  }

  my $sfdentry;

  if (defined ($sfd[$unicode])) {
    $sfdentry = $sfd[$unicode];
  }
  else {
    printf(STDERR "\`%s' (U+%04X) not in subfont encoding\n",
           $glyphnameref, $unicode);
    next;
  }

  print("\\CJKvdef{m/n/$sfdentry}");
  print("{\\def\\CJK\@plane{v}\\selectfont\\CJKsymbol{$index}}\n");
}


# Read an AGL file.
#
#  $1: Name of the AGL file.
#  $2: Reference to the target hash file, mapping from the glyph name
#      to the Unicode value.

sub read_aglfile {
  my ($aglfile, $aglhash) = @_;

  print("Reading Adobe Glyph List file \`$aglfile'...\n");

  open(AGL, $aglfile)
  || die("$prog: can't open \`$aglfile': $!\n");

  while (<AGL>) {
    chop;

    next if /^\s*$/;
    next if /^#/;

    my @field = split(";");
    $aglhash->{$field[1]} = hex($field[0]);
  }
  close(AGL);
}


# Read an SFD file.
#
#   $1: Name of the SFD file.
#   $2: Reference to the target array file, mapping from the character code
#       to the subfont index. The format of an array value is the
#       concatenation of the subfont suffix, a slash, and the index.

sub read_sfdfile {
  my ($sfdfile, $sfdarray) = @_;

  print("Reading subfont definition file \`$sfdfile'...\n");

  open(SFD, $sfdfile)
  || die("$prog: can't open \`$sfdfile': $!\n");

  my $line;
  my $continuation = 0;
  while (<SFD>) {
    chop;

    next if /^\s*$/;
    next if /^#/;

    if ($continuation) {
      $line .= $_;
    }
    else {
      $line = $_;
    }
    $continuation = 0;

    if ($line =~ s/\\$//) {
      $continuation = 1;
      next;
    }

    $_ = $line;
    my @field = split(" ");

    my $suffix = $field[0];

    shift(@field);
    my $index = 0;

    while (@field) {
      if ($field[0] =~ /(.*):$/) {
        $index = $1;
      }
      elsif ($field[0] =~ /(.*)_(.*)/) {
        my $start = $1;
        my $end = $2;
        $start = oct($start) if ($start =~ /^0/);
        $end = oct($end) if ($end =~ /^0/);
        foreach my $i ($start .. $end) {
          $sfdarray->[$i] = "$suffix/$index";
          $index++;
        }
      }
      else {
        my $value = $field[0];
        $value = oct($value) if ($value =~ /^0/);
        $sfdarray->[$value] = "$suffix/$index";
        $index++;
      }
      shift(@field);
    }
  }
  close(SFD);
}


# Read AFM file.
#
#   $1: Name of the AFM file.
#   $2: Reference to array which maps glyph indices to glyph names.
#       `vertical.pe' guarantees that there are no holes in the array.

sub read_afmfile {
  my ($afmfile, $maparray) = @_;

  print("Reading metrics file \`$afmfile'\n");

  open(AFM, $afmfile)
  || die("$prog: can't open \`$afmfile': $!\n");

  while (<AFM>) {
    if (/^C \d+ ;/) {
      / N (.*?) ;/;
      push (@$maparray, $1);
    }
  }
  close(AFM);
}


# eof