/* afm2pl
 * Copyright (C) 2002, 2005 Siep Kroonenberg
 * ntg-afm2pl@ntg.nl
 * based on afm2tfm.
 */

/* Here the opening comments from afm2tfm:
 *********************************************************************
 * (Modified by Don Knuth from Tom Rokicki's pre-VPL version.)
 *
 * VM/CMS port by J. Hafner (hafner@almaden.ibm.com), based on
 * the port by Alessio Guglielmi (guglielmi@ipisnsib.bitnet)
 * and Marco Prevedelli (prevedelli@ipisnsva.bitnet).
 * This port is still in test state.  No guarantees.
 * 11/3/92: more corrections to VM/CMS port. Now it looks correct
 * and will be supported by J. Hafner.
 *
 * More changes, primarily from Karl Berry, enough for a new version
 * number to 8.0; 1 December 1996.  Note that this version computes
 * checksums differently (more intelligently).
 *
 *********************************************************************/

/* Changed features:
 * writes pl with lig- and kern info instead of tfm
 * never adds characters not explicitly specified in the encoding
 * extra ligkern info, previously hardwired in the source, is now
 * read from an external file. This may include accented char ligatures.
 * Default behavior still matches afm2tfm, given the right ligkern
 * files.
 * letterspacing option, implemented as kerning pairs between any
 * two characters.
 *
 * For VM/CMS we no longer need asciified names for the font or the
 * encoding since we write an ascii pl file instead of a binary tfm.
 *
 * This version doesn't try as hard to always give sensible output.
 * On the other hand, since it uses simpler logic, it should be
 * easier for the user to figure out the cause of failures.
 *
 * changes in structure:
 * writes character metrics directly to an array
 * metric information is transformed in stages
 * does not create smallcaps
 */

/* differences between afm and tfm:
 * afm usually has a space char
 * afm lists chars by name and also includes unencoded chars
 * afm lists ligatures together with their first `component',
 *   and lists kerns separately.
 * afm implies 3-way ligs by recursive application of 2-way glyphs
 * afm allows negative heights and depths
 *
 * tfm usually doesn't have a space char
 * tfm may have boundarychar ligkerns instead of space ligkerns
 * tfm is lists chars by code and is glyphname-agnostic
 * tfm contains a ligkern table, where entries are sorted by left
 *   `component'. 3-way ligs are written out in one lig `program'.
 * tfm may contain some special-purpose ligs such as
 *   question quoteleft =: questiondown
 */

/*******************************************************************
 * includes, defines, system */

#ifdef HAVE_CONFIG_H
#define KPATHSEA 1
#include <kpathsea/config.h>
#include <kpathsea/debug.h>
#include <kpathsea/tex-file.h>
#include "c-auto.h"
#include <kpathsea/c-ctype.h>
#include <kpathsea/progname.h>
#else /* standalone compile */
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#if defined(SYSV) || defined(VMS) || defined(__THINK__) || defined(MSDOS) || defined(OS2) || defined(ATARIST) || defined(WIN32)
#include <string.h>
#else
#include <strings.h>
#endif
#include <math.h>
#ifdef ATARIST
#include <float.h>
#endif
#endif /* KPATHSEA */

#ifdef VMCMS
#define interesting lookstr     /* for 8 character truncation conflicts */
#include "dvipscms.h"
extern FILE *cmsfopen ();
extern char ascii2ebcdic[];
#ifdef fopen
#undef fopen
#endif
#define fopen cmsfopen
#endif

/* from dvips.h:

#ifdef VMS
#include "[.vms]vms.h"
#endif /* VMS */

/*
 *   Is your malloc big?
 */
#if defined(MSDOS) && !defined(__EMX__) && !defined(DJGPP)
#define SMALLMALLOC
#endif
#if defined(OS2) && defined(_MSC_VER)
#define SMALLMALLOC
#endif

#if (defined(MSDOS) && !defined(DJGPP)) || (defined(OS2) && defined(_MSC_VER)) || defined(ATARIST)
typedef long integer;
#else
typedef int integer;
#endif

#ifndef KPATHSEA
typedef char boolean;
#endif

#ifdef WIN32
#define Boolean boolean
#else
#ifndef __THINK__
typedef short Boolean ;
#endif
#endif

/**************************************************************
 * data structures */

/* Adobe char metrics; one lig- and kern linked list for each
 * adobechar
 */

struct lig {
  struct lig *next;
  char *succ, *sub;
  short op, boundright;         /* boundright: succ is rboundarychar */
};

struct kern {
  struct kern *next;
  char *succ;
  int delta;
};

/* metric info for one char */
struct adobeinfo {
  int adobenum, tfmnum, width;
  char *adobename;
  int llx, lly, urx, ury;
  int nonstd_lk; /* non-standard ligs and/or kerns */
  struct lig *ligs;
  struct kern *kerns;
};
/* The nonstd_lk field is for efficiency in case of letterspacing.
 * With letterspacing, all glyphs originally without ligs or
 * kerns do show up in the ligkern table, but with identical
 * information. We write them in one go to the ligkern table.
 */

/* encodings */
struct encoding {
  char *name;
  char *vec[256];
};

/* struct to store the names of files with extra ligkern info */
struct nstrings {
  int n;
  char **names;
};

/*************************************************************
 * global vars */

#define buflen 256
char buffer[buflen];            /* input buffer (modified while parsing) */
char obuffer[buflen];           /* unmodified copy of input buffer */
char *param;                    /* current position in input buffer */

char *fontname = "Unknown";
char *codingscheme = "UNSPECIFIED";

struct encoding *afmencoding = NULL;
struct encoding *outencoding = NULL;
char *ligoption = "1";          /* which extra ligkerns? */
char *Ligoption = "1";          /* extra ligkern info after letterspacing */
int based_on;                   /* name output file based on name afm file? */

FILE *infile, *outfile;
char *afmname, *outname;        /* names of input and output files */
char *encfilename;              /* encoding file */
struct nstrings *ligfilenames;  /* for files with extra ligkern info */
struct nstrings *Ligfilenames;  /* same; for after letterspacing */
char *ligfilename;

struct adobeinfo
**adobechars,                   /* array of adobeinfo structs, from afm and in afm order */
 *tfmptrs[256];                 /* same, but indexed by tfm order */

int tfmnext[256];               /* for characters encoded multiple times in output */

/* global font info */
int iglyph, nglyphs, nglyphsb;  /* glyph no., n. of glyphs in afm */
float italicangle = 0.0;
float newslant = 0.0; /* computed from slant and italicangle */
int fixedpitch;
int afm2tfm_compat = 0; /* create afm2tfm-compatible font dimensions */
int xheight = 0;
int fontspace = -1;
int fstretch = -1;
int fshrink = -1;
int fextra = -1;
int fquad = -1;
int charwidth = 0;

float efactor = 1.0, slant = 0.0;       /* requested transformation */
int lspace = 0;                 /* for letterspacing */
char *efactorparam, *slantparam, *lspaceparam;
int forceoctal = 0;
int keepligs = 0;               /* retain afm ligs in spite of lspace>0 */

int rboundarychar = -1;         /* the (right) boundary character */
char *boundaryname = "||";      /* name of boundarychars for liginfo specs */
struct adobeinfo *rbound, *lbound;
char *boundglyph = NULL;
  /* glyph name of rboundarychar; non-null only if encoded */
  /* track presence of r- and l boundarychar ligkerns.
   * we don't check whether the real chars in those ligkerns
   * are encoded, so we may get false positives
   */

int missingchars = 0;
int verbose = 0;

/**************************************************************
 * general utility functions */

/* see dvips.h about PnC and PnH: a trick to turn prototypes on or
 * off with one #define */

/* little hack: error message is warning unless it starts with '!' */
void
  error
P1C (register char *, s)
{
  char *parasave;
  parasave = param;
  (void) fprintf (stderr, "%s\n", s);
  if (obuffer[0]) {
    (void) fprintf (stderr, "%s\n", obuffer);
    while (param > buffer) {
      (void) fprintf (stderr, " ");
      param--;
    }
    (void) fprintf (stderr, "^\n");
  }
  if (*s == '!')
    exit (1);
  param = parasave;
}

char *mymalloc
P1C (unsigned long, len)
{
  register char *p;
  unsigned long i;

#ifdef SMALLMALLOC
  if (len > 65500L)
    error ("! can't allocate more than 64K!");
#endif
  p = malloc ((unsigned) len);
  if (p == NULL)
    error ("! out of memory");
  for (i = 0; i < len; i++)
    p[i] = 0;
  return (p);
}

char *newstring
P1C (char *, s)
{
  char *q = mymalloc ((unsigned long) (strlen (s) + 1));
  (void) strcpy (q, s);
  return q;
}

/* find a glyph name in an adobeinfo array */
struct adobeinfo *findname
P3C (struct adobeinfo **, achars, int, n, char *, p)
{
  register int i;
  for (i = 0; i < n; i++)
    if (achars[i] && strcmp (p, achars[i]->adobename) == 0)
      return achars[i];
  return NULL;
}

/* Find glyph info by name in the original adobechars array
 * We don't include the boundarychars in the search but always test
 * separately for those.
 */
struct adobeinfo *findadobe
P1C (char *, p)
{
  return findname (adobechars, nglyphs, p);
}

/* Find glyph info by name in target encoding */
struct adobeinfo *findtfm
P1C (char *, p)
{
  return findname (tfmptrs, 256, p);
}

/* just for adobechars, we sometimes want the index instead */
int findindex
P1C (char *, p)
{
  int i;
  for (i = 0; i < nglyphs; i++)
    if (adobechars[i] && strcmp (p, adobechars[i]->adobename) == 0)
      return i;
  return -1;
}

/* geometrically transformed boundingbox */
int
  transform
P2C (register int, x, register int, y)
{
  register double acc;
  acc = efactor * x + slant * y;
  return (int) (acc >= 0 ? floor (acc + 0.5) : ceil (acc - 0.5));
}

/* read a line from infile into buffer and obuffer */
int
  getline
P1H (void)
{
  register char *p;
  register int c;
  int maxline;

  param = buffer;
  p = buffer;
  maxline = buflen;
  c = 0; /* to suppress phony compiler warning */
  while (((c = getc (infile)) != EOF) && (c != '\n') && (c != '\r'))
    /* added: test for \r. The way we do it, the DOS cr/lf convention
     * leads to alternating empty lines, but that is ok.
     */
    if (--maxline > 0) *p++ = c;
  *p = 0;
  (void) strcpy (obuffer, buffer);
  if (p == buffer && c == EOF)
    return (0);
  else
    return (1);
}

/*******************************************************
 * file handling
 */

#ifndef KPATHSEA
/* simple versions of concat (concatenate with allocation),
 * kpse_find_suffix, xbasename and an enum for kpse_file_format_type.
 * This is to reduce the number of #ifdef KPATHSEA sections.
 */
typedef enum {
  kpse_afm_format, kpse_lig_format, kpse_enc_format
} kpse_file_format_type;

/* string concatenation with allocation */
char *concat
P2C (char *, s1, char *, s2)
{
  char *answer = (char *) malloc (strlen (s1) + strlen (s2) + 1);
  strcpy (answer, s1);
  strcat (answer, s2);

  return answer;
}

/* Return pointer to first character after `.' in last directory element
 * of NAME.  If the name is `foo' or `/foo.bar/baz', we have no extension.
 */
char *find_suffix
P1C (char *, name)
{
  char *slash_pos;
  char *dot_pos = (char *) strrchr (name, '.');

  if (dot_pos == NULL)
    return NULL;

  /* find last directory separator */
  for (slash_pos = name + strlen (name);
       slash_pos > dot_pos &&
       (*slash_pos != ':' && *slash_pos != '\\' && *slash_pos != '/');
       slash_pos--);

  /* accept suffix only if after last path separator */
  return slash_pos > dot_pos ? NULL : dot_pos + 1;
}

/* Return pointer to filename with leading path stripped */
char *xbasename
P1C (char *, name)
{
  char *base = NULL;
  unsigned len = strlen (name);

  for (len = strlen (name); len > 0; len--) {
    if (name[len - 1] == ':' || name[len - 1] == '\\'
        || name[len - 1] == '/') {
      base = name + len;
      break;
    }
  }
  if (!base)
    base = name;
  return base;
}

#endif
/* end of KPATHSEA replacements */

/* file open functions; abort in case of failure; return filename */

/* open file for reading
 * parameters: (pointer to) requested filename
 * return (pointer to) actual filename without dir
 * Since we only have one input file open at any time
 * we use a global file variable infile.
 * Note. The kpse lib fu concat itself takes care of
 * allocating the result string
 * kpse handling isn't so helpful in the enc- and lig cases,
 * so we add a suffix explicitly.
 */
char *openin
P3C (char *, fname, kpse_file_format_type, format, char *, ext)
{
  char *realfname;

#ifdef KPATHSEA
  realfname = kpse_find_file (fname, format, false);
  if (!realfname) {
    realfname = concat (fname, ext);
    realfname = kpse_find_file (realfname, format, false);
  }
  if (!realfname)
    FATAL1 ("%s not found", fname);
  infile = kpse_open_file (realfname, format);
  if (infile)
    return (char *)xbasename (realfname);
  else
    FATAL1 ("couldn't open %s", realfname);
#else
  realfname = fname;
  infile = fopen (realfname, "r");
  if (!infile && !find_suffix (realfname)) {
    realfname = concat (fname, ext);
    infile = fopen (realfname, "r");
  }
  if (infile)
    return realfname;
  else
    error (concat ("!couldn't open ", realfname));
#endif
  return NULL;
}

/* open file for writing
 * Parameter based_on: if non-zero, then fname was the name
 * of the afm file, and we have to construct a new name
 * based on fname:
 * - replace an extension ".afm" with ".pl"
 * - strip leading path+
 * In this function, kpathsea functions don't provide better
 * functionality, but they do improve portability.
 */
char *openout
P3C (char *, fname, int, based_on, char *, outext)
{
  char *inext = ".afm";
  /* use inext+1 and outext+1 when the leading dot is not desired */
  char *realfname, *suf;

  if (based_on) {  /* compute output filename */
    suf = find_suffix (fname);
    if (suf && !strcmp ((inext + 1), suf)) {    /* replace afm suffix */
      realfname = newstring (fname);
      suf = find_suffix (realfname);
      suf[0] = 0;
      strcat (realfname, (outext + 1));
      /* no allocation required: new suffix not longer than old one */
    } else         /* append new suffix */
      realfname = concat (fname, outext);
    realfname = (char *)xbasename (realfname);
  } else {
    suf = find_suffix (fname);
    if (suf)
      realfname = fname;
    else
      realfname = concat (fname, outext);
  }
  outfile = fopen (realfname, "w");
  /* afm2tfm uses WRITEBIN instead of "w" for some OS-es */
  if (outfile)
    return realfname;
  else
    error (concat ("!", concat (realfname, " not found")));
  return NULL;
}

/********************************************************
 * reading the afm
 */

char *interesting[] = { "FontName", "ItalicAngle", "IsFixedPitch",
  "XHeight", "C", "KPX", "EncodingScheme",
  "StartCharMetrics", "CharWidth", NULL
};
#define FontName (0)
#define ItalicAngle (1)
#define IsFixedPitch (2)
#define XHeight (3)
#define C (4)
#define KPX (5)
#define EncodingScheme (6)
#define StartCharMetrics (7)
#define CharWidth (8)
#define NONE (-1)
int
  interest
P1C (char *, s)
{
  register char **p;
  register int n;

  for (p = interesting, n = 0; *p; p++, n++)
    if (strcmp (s, *p) == 0)
      return (n);
  return (NONE);
}

/* At function call, param points to the first char of the next
 * string, or to eol.
 * In the input buffer, a terminating space is replaced with a null char.
 * Before termination, param is moved to the start of the next
 * string, or to eol.
 */

/* next (parameter) string (param is input pointer),
 * with allocation */

char *paramnewstring
P1H (void)
{
  register char *p, *q;

  p = param;
  while (*p > ' ')
    p++;
  if (*p != 0)
    *p++ = 0;
  q = newstring (param);
  while (*p && *p <= ' ')
    p++;
  param = p;
  return (q);
}

/* next (parameter) string from afm file (param is input pointer),
 * pre-allocated */

char *paramstring
P1H (void)
{
  register char *p, *q;

  p = param;
  while (*p > ' ')
    p++;
  q = param;
  if (*p != 0)
    *p++ = 0;
  while (*p && *p <= ' ')
    p++;
  param = p;
  return (q);
}

int
  paramnum
P1H (void)
{
  register char *p;
  int i;

  p = paramstring ();
  if (sscanf (p, "%d", &i) != 1)
    error ("! integer expected");
  return (i);
}

float
  paramfloat
P1H (void)
{
  register char *p;
  float i;

  p = paramstring ();
  if (sscanf (p, "%f", &i) != 1)
    error ("! number expected");
  return (i);
}

void
  expect
P1C (char *, s)
{
  if (strcmp (paramstring (), s) != 0) {
    (void) fprintf (stderr, "%s expected: ", s);
    error ("! syntax error");
  }
}

/* allocating and initializing structs */

/* initialize afm info for one char */
struct adobeinfo *newchar
P1H (void)
{
  register struct adobeinfo *ai;

  ai = (struct adobeinfo *) mymalloc ((unsigned long)
                                      sizeof (struct adobeinfo));
  ai->adobenum = -1;
  ai->tfmnum = -1;
  /* ai->kern_as = NULL; */
  ai->width = -1;
  ai->adobename = NULL;
  ai->llx = -1;
  ai->lly = -1;
  ai->urx = -1;
  ai->ury = -1;
  ai->ligs = NULL;
  ai->kerns = NULL;
  /* ai->kern_equivs = NULL ; */
  return (ai);
}

struct kern *newkern
P1H (void)
{
  register struct kern *nk;

  nk = (struct kern *) mymalloc ((unsigned long) sizeof (struct kern));
  nk->next = NULL;
  nk->succ = NULL;
  nk->delta = 0;
  return (nk);
}

struct lig *newlig
P1H (void)
{
  register struct lig *nl;

  nl = (struct lig *) mymalloc ((unsigned long) sizeof (struct lig));
  nl->next = NULL;
  nl->succ = NULL;
  nl->sub = NULL;
  nl->op = 0;      /* the default =: op */
  nl->boundright = 0;
  return (nl);
}

/* read and interpret afm info for 1 char
 * adobeptrs is an array of pointers to adobeinfo structs
 * indexed by adobenum.
 * */
void
  handlechar
P1H (void)
{                  /* an input line beginning with C */
  register struct adobeinfo *ai;
  register struct lig *nl;

  if ((++iglyph) >= nglyphs)
    error ("!Too many glyphs in afm");
  adobechars[iglyph] = newchar ();
  ai = adobechars[iglyph];
  ai->adobenum = paramnum ();
  expect (";");
  expect ("WX");
  ai->width = paramnum ();
  if (fixedpitch)
    charwidth = ai->width;
  expect (";");
  expect ("N");
  ai->adobename = paramnewstring ();
  if ((ai->adobenum) >= 0)
    afmencoding->vec[ai->adobenum] = newstring (ai->adobename);
  expect (";");
  expect ("B");
  ai->llx = paramnum ();
  ai->lly = paramnum ();
  ai->urx = paramnum ();
  ai->ury = paramnum ();
  expect (";");
/* Now look for ligatures (which aren't present in fixedpitch fonts) */
  while (*param == 'L' && !fixedpitch) {
    expect ("L");
    nl = newlig ();
    nl->succ = paramnewstring ();
    nl->sub = paramnewstring ();
    nl->next = ai->ligs;
    ai->ligs = nl;
    expect (";");
  }
}

void
  handlekern
P1H (void)
{                  /* an input line beginning with KPX */
  register struct adobeinfo *ai;
  register char *p, *sc;
  register struct kern *nk;
  int dlt;

  p = paramstring ();
  ai = findadobe (p);
  if (!ai)
    error ("kern char not found");
  else {
    sc = paramstring ();
    dlt = paramnum ();
    if (dlt) {
      nk = newkern ();
      nk->succ = newstring (sc);
      nk->delta = dlt;
      nk->next = ai->kerns;
      ai->kerns = nk;
    }
  }
}

/* read afm file */
void
  readadobe
P1H (void)
{
  struct adobeinfo *ai;
  char *inname;
  int i;

  /* open afm file */
  inname = newstring (afmname);
  inname = openin (inname, kpse_afm_format, ".afm");

  nglyphs = -1;    /* allocate adobechars at StartCharMetrics */
  afmencoding = (struct encoding *) mymalloc ((unsigned long)
                                              sizeof (struct encoding));
  for (i = 0; i < 256; i++)
    afmencoding->vec[i] = ".notdef";
  afmencoding->name = "Unspecified";

  while (getline ()) {
    switch (interest (paramstring ())) {
    case FontName:
      fontname = paramnewstring ();
      break;
    case EncodingScheme:
      afmencoding->name = paramnewstring ();
      break;
    case ItalicAngle:
      italicangle = paramfloat ();
      break;
    case IsFixedPitch:
      if (*param == 't' || *param == 'T')
        fixedpitch = 1;
      else
        fixedpitch = 0;
      break;
    case XHeight:
      xheight = paramnum ();
      break;
    case StartCharMetrics:
      nglyphs = paramnum ();
      nglyphsb = nglyphs + 1;
      iglyph = -1;
      /* Allocate adobechars array (just the array of pointers).
       * Reserve extra slot for rboundarychar
       */
      adobechars =
        (struct adobeinfo **) mymalloc ((unsigned long) (nglyphs+1) *
                                        (unsigned long) sizeof (struct
                                                                adobeinfo
                                                                *));
      break;
    case C:
      handlechar ();
      break;
    case KPX:
      handlekern ();
      break;
    case CharWidth:
      charwidth = paramnum ();
      fixedpitch = 1;
      break;
    default:
      break;
    }
  }
  fclose (infile);
  infile = NULL;
}

/* now some changes to the afm info */
void
  changeadobe
P1H (void)
{
  struct adobeinfo *ai;
  int i;
  /* float newslant; local declaration masks global one */

  /* A fix: avoiding negative heights or depths.
   * They break accents in math mode, among other things.
   */
  for (i = 0; i < nglyphs; i++) {
    ai = adobechars[i];
    if (ai->lly > 0)
      ai->lly = 0;
    if (ai->ury < 0)
      ai->ury = 0;
  }

  /* apply any requested geometric transforms */
  if (efactor != 1.0 || slant != 0.0) {
    for (i = 0; i < nglyphs; i++) {
      ai = adobechars[i];
      ai->width = transform (ai->width, 0);
      ai->llx = transform (ai->llx, ai->lly);
      ai->urx = transform (ai->urx, ai->ury);
    }
  }
  newslant = (double) slant -
    efactor * tan (italicangle * (3.1415926535 / 180.0));

  /* if !keepligs, remove native ligatures */
  if (!keepligs && lspace>0) {
    for (i = 0; i < nglyphs; i++)
      adobechars[i]->ligs = NULL;
  }

  /* create a left and right boundarychar entries - just in case,
   * but don't add them (yet) to adobechars */
  for (i = 0; i < 2; i++) {
    ai = newchar ();
    ai->adobenum = -1;
    ai->width = 0;
    ai->llx = 0;
    ai->lly = 0;
    ai->urx = 0;
    ai->ury = 0;
    ai->adobename = boundaryname;
    if (i == 0)
      lbound = ai;
    else
      rbound = ai;
  }

  /* global font dimensions */

  /* The following may depend on the -f parameter */

  if (xheight == 0) {
    ai = findadobe ("x");
    if (ai)
      xheight = ai->ury;
    else
      xheight = 400;
  }

  if (afm2tfm_compat) { /* -f 'afm2tfm'*/

    ai = findadobe ("space");
    if (ai)
      fontspace = ai->width; /* transform already applied */
    else {
      if (fixedpitch)
        fontspace = charwidth;
      else
        transform(500, 0);
    }
    fstretch = (fixedpitch) ? 0 : transform (300, 0);
    fshrink = (fixedpitch) ? 0 : transform (100, 0);
    /* fextra = transform (111, 0); */
    fquad = transform (1000, 0);

  } else if (!fixedpitch) {

    /* some may be set by a numerical -f parameter) */

    if (fontspace<0) {
      ai = findadobe ("space");
      if (ai)
        fontspace = ai->width; /* transform already applied */
      else {
        fontspace = transform(500, 0);
      }
    }
    if (fquad<0) {
      ai = findadobe ("zero");
      if (ai) fquad = 2 * ai->width;
      else if (fixedpitch) fquad = 2 * charwidth;
      else fquad = transform (1000, 0);
    }
    if (fstretch<0) fstretch = fontspace / 2;
    if (fshrink<0) fshrink = fontspace / 3;
    if (fextra<0) fextra = fontspace / 3;
  } else { /* fixedpitch && !afm2tfm_compat */
    if (fontspace<0) fontspace = charwidth;
    if (fstretch<0) fstretch = 0;
    if (fshrink<0) fshrink = 0;
    if (fquad<0) fquad = 2 * charwidth;
    if (fextra<0) fextra = charwidth;
  }
}

/**************************************************
 * reading encodings
 */

char smbuffer[100];             /* for tokens */

/*   Here we get a token from the encoding file.  We parse just as
 *   much PostScript as we expect to find in an encoding file.  We
 *   allow commented lines and names like 0, .notdef, _foo_.  We do
 *   not allow //abc.
 */
char *
gettoken ()
{
  char *p, *q;

  while (1) {
    while (param == 0 || *param == 0) {
      if (getline () == 0)
        error ("! premature end in encoding file");
    }
    if (param[0] == '%') {
      param[0] = 0;     /* be done with this line */
      continue;
    }
    while (*param && *param <= ' ')
      param++;
    if (*param) {
      if (*param == '[' || *param == ']' ||
          *param == '{' || *param == '}') {
        smbuffer[0] = *param++;
        smbuffer[1] = 0;
        return smbuffer;
      } else if (*param == '/' || *param == '-' || *param == '_' ||
                 *param == '.' ||
                 ('0' <= *param && *param <= '9') ||
                 ('a' <= *param && *param <= 'z') ||
                 ('A' <= *param && *param <= 'Z')) {
        smbuffer[0] = *param;
        for (p = param + 1, q = smbuffer + 1;
             *p == '-' || *p == '_' || *p == '.' ||
             ('0' <= *p && *p <= '9') ||
             ('a' <= *p && *p <= 'z') ||
             ('A' <= *p && *p <= 'Z'); p++, q++)
          *q = *p;
        *q = 0;
        param = p;
        return smbuffer;
      }
    }
  }
}

/* This routine reads the encoding file.
 * Return value: pointer to encoding.
 *
 * There is just one reason why we read the encoding vector
 * before the extra ligkern information: if a (r)boundarychar is
 * specified by number then we want to translate it into
 * a glyph name.
 *
 * We also create tfmptrs as a reencoded version of adobechars, and
 * tfmnext, which tracks multiple encodings of a single glyph and is
 * best explained by the code creating it.
 */
void
  readencoding
P1H (void)
{
  char *p;
  int i, inx;
  struct adobeinfo *ai;

  if (infile)
    error ("! oops; internal infile error");
  if (encfilename) {
    encfilename =
      openin (encfilename, kpse_enc_format, ".enc");
    param = 0;
    if (infile == 0)
      error ("! couldn't open that encoding file");
    outencoding = (struct encoding *) mymalloc
      ((unsigned long) sizeof (struct encoding));
    for (i = 0; i < 256; i++)
      outencoding->vec[i] = ".notdef";
    outencoding->name = "Unspecified";
    p = gettoken ();
    if (*p != '/' || p[1] == 0)
      error ("! first token in encoding must be literal encoding name");
    outencoding->name = newstring (p + 1);
    p = gettoken ();
    if (strcmp (p, "["))
      error ("! second token in encoding must be mark ([) token");
    for (i = 0; i < 256; i++) {
      p = gettoken ();
      if (*p != '/' || p[1] == 0)
        error ("! tokens 3 to 257 in encoding must be literal names");
      outencoding->vec[i] = newstring (p + 1);
    }
    p = gettoken ();
    if (strcmp (p, "]"))
      error ("! token 258 in encoding must be make-array (])");
    fclose (infile);
    infile = 0;
  } else
    outencoding = afmencoding;

  /* find adobeinfo for each encoded glyph name
   * track multiple encodings (tfmnext).
   * For missing glyphs, this is not necessary.
   */
  for (i = 0; i < 256; i++)
    tfmnext[i] = -1;
  for (i = 0; i < 256; i++) {
    if (strcmp (outencoding->vec[i], ".notdef")) {
      ai = findadobe (outencoding->vec[i]);
      tfmptrs[i] = ai;
      if (ai) {
        inx = ai->tfmnum;
        if (inx == -1)
          ai->tfmnum = i;
        else {
          while (tfmnext[inx] != -1)
            inx = tfmnext[inx];
          tfmnext[inx] = i;
        }
      } else { /* missing glyph */
        if (!missingchars && verbose)
          fputs ("Missing glyphs\n", stderr);
        missingchars += 1;
        if (verbose) printf ("%s\n", outencoding->vec[i]);
      }
    } else /* empty slot */
      tfmptrs[i] = NULL;
  }
}

/****************************************************************
 * Processing extra ligkern info
 *
 * When these functions are called, we have available the afm data
 * and the raw encoding vector.
 * changeadobe has created adobeinfos for left and right boundarychar.
 * We use the encoding vector ONLY to translate an rboundarychar spec
 * into an rboundarychar name. However, normally an rboundarychar will
 * occupy an otherwise unused slot in the encoding, in which case
 * the name is irrelevant.
 * I don't see the point of a numeric rboundarychar specification:
 * either one wants to use a specific character or the numeric value
 * doesn't matter. But I allow it for backward compatibility.
 *
 * extra ligkern info can come from:
 * - comments in the encoding file
 * - lig files. These replace the hard-coded set in afm2tfm.
 * afm2tfm applies its own set only if the enc file contains no
 * ligkern instructions. This is also the default behavior of
 * afm2pl.
 *
 * Typically, extra ligkern info may contain:
 * - tex-specific hacks such as `less less =: guillemotleft'
 * - deletion of space- and number kerns
 * - kern accented chars as their unaccented versions
 * - the f/l/i ligatures, in case they were absent from the afm.
 *
 * note. afm2pl allows first copying space kerns
 * to boundarychar kerns and then deleting the space kerns, leaving
 * the boundarychar kerns intact.
 *
 * There was a function for creating accented char ligatures.
 * This doesn't prevent TeX from compositing accented chars
 * so it is not very useful.
 * In afm2tfm this function was never called and I removed it.
 * I created a file accents.lig which may be loaded for these
 * accent ligs but default isn't.
 */

/* Notation of ligkern specs:
 * char1 char2 =: char3    => replace char1 char2 with char3
 *   and more generally:
 * char1 char2 ligop char3 => char1 char2 ligop char3
 * char1 {} char2          => delete char1 char2 kern
 * char1 <> char2          => kern char1 the same as char2
 * || = char               => char is right boundary char
 *
 * Notes.
 * - cork.enc contains specs `char @{@} char' instead of `char {} char'
 * - The ligkern specs use `||' for both lboundarychar and
 *   rboundarychar. The context must make clear which one is intended.
 *   I store them in separate adobechar structs.
 */

/* These are the eight ligature ops, in pl terms and in METAFONT terms.
 */
char *plligops[] = {
  "LIG", "/LIG", "/LIG>", "LIG/", "LIG/>", "/LIG/", "/LIG/>",
  "/LIG/>>", 0
};
char *encligops[] = {
  "=:", "|=:", "|=:>", "=:|", "=:|>", "|=:|", "|=:|>", "|=:|>>", 0
};

/* Make the kerning for character s1 equivalent to that for s2
 * but don't replace existing kerns.
 * It doesn't matter whether or not s2 is encoded.
 * In the pl file, the kerning info of both s1 and s2 will be written
 * out in full.
 */
void
  copykerns
P2C (char *, s1, char *, s2)
{
  int i, found, delta2, found1, found2;
  struct adobeinfo *ai, *ai1, *ai2;
  struct kern *nk, *nk1, *nk2;

  if (!strcmp (s1, s2))
    return;

  /* kerns with s1 and s2 on the left */
  if (!strcmp (boundaryname, s1))
    ai1 = lbound;
  else
    ai1 = findadobe (s1);
  if (!strcmp (boundaryname, s2))
    ai2 = lbound;
  else
    ai2 = findadobe (s2);
  if (ai1 && ai2 && ai2->kerns) {
    nk2 = ai2->kerns;
    while (nk2) {
      found = 0;
      nk1 = ai1->kerns;
      while (nk1) {
        if (!strcmp (nk1->succ, nk2->succ)) {
          found = 1;
          break;
        }
        nk1 = nk1->next;
      }
      if (!found) {
        nk1 = newkern ();
        nk1->succ = nk2->succ;
        nk1->delta = nk2->delta;
        nk1->next = ai1->kerns;
        ai1->kerns = nk1;
      }
      nk2 = nk2->next;
    }
  }

  /* kerns with s1 and s2 on the right. */
  if (!strcmp (boundaryname, s1) && boundglyph)
    s1 = boundglyph;
  if (!strcmp (boundaryname, s2) && boundglyph)
    s2 = boundglyph;
  /* a name '||' for s1/s2 is untouched */
  if (!strcmp (s1, s2))
    return;
  for (i = 0; i < nglyphs; i++) {
    ai = adobechars[i];
    found1 = 0;
    found2 = 0;
    nk = ai->kerns;
    while (nk) {
      if (!strcmp (nk->succ, s2)) {
        found2 = 1;
        delta2 = nk->delta;
      }
      if (!strcmp (nk->succ, s1))
        found1 = 1;
      nk = nk->next;
    }
    if (found2 && !found1) {
      nk1 = newkern ();
      nk1->next = ai->kerns;
      ai->kerns = nk1;
      nk1->succ = newstring (s1);
      /* can't copy s1, which is just a stack variable */
      nk1->delta = delta2;
    }
  }
}

/* remove kern between ai->adobechar and s2, where s2 != "*"
 */
void adobermkern
P2C (struct adobeinfo *, ai, char *, s2)
{
  struct kern *k, *kprev;
  char *s2a;
  int first;
  if (!ai->kerns)
    return;
  k = ai->kerns;
  if (!strcmp (s2, boundaryname) && boundglyph)
    s2a = boundglyph;
  else
    s2a = s2;
  first = 1;
  while (k) {
    if (!strcmp (s2a, k->succ) || !strcmp (s2, k->succ)) {
      if (first)
        ai->kerns = k->next;
      else
        kprev->next = k->next;
      return;
    }
    first = 0;
    kprev = k;
    k = k->next;
  }
}

/* remove kerns between s1 and s2 (wildcards allowed) */
void rmkern
P2C (char *, s1, char *, s2)
{
  int i;
  struct adobeinfo *ai;

  if (!strcmp (s1, "*")) {
    for (i = 0; i < nglyphs; i++) {
      ai = adobechars[i];
      adobermkern (ai, s2);
    }
    adobermkern (lbound, s2);
  } else if (!strcmp (s2, "*")) {
    if (!strcmp (s1, boundaryname))
      ai = lbound;
    else
      ai = findadobe (s1);
    if (ai)
      ai->kerns = NULL;
  } else {         /* remove single pair */
    if (!strcmp (s1, boundaryname))
      ai = lbound;
    else
      ai = findadobe (s1);
    if (!ai)
      return;
    adobermkern (ai, s2);
  }
}

/* With default ligkern option, need to know whether
 * the enc file contains ligkern specs
 */
int sawligkern;

/* zero-th iteration: look out for rboundarychar spec.
 * first iteration: look out for everything else.
 */
int lig_it;

/* set_rboundarychar is to be called after the ligkern specs have been
 * scanned for a rboundarychar spec but before we know whether it
 * will actually be used.
 */
void set_rboundarychar
P1C (int, bch)
{
  int i;
  if (bch == -1) {
    /* find empty slot; skip 0, just to be safe */
    for (i = 1; i < 256; i++)
      if (!strcmp (outencoding->vec[i], ".notdef")) {
        rboundarychar = i;
        tfmptrs[i] = rbound;
        rbound->tfmnum = i;
        adobechars[nglyphs] = rbound;
        return;
      }
    error ("No tfm slot available for boundarychar");
  } else {
    rboundarychar = bch;
    if (tfmptrs[rboundarychar]) {
      rbound = tfmptrs[rboundarychar];
      boundglyph = newstring (rbound->adobename);
      nglyphsb = nglyphs; /* no extra slot in adobechars needed */
    } else {
      tfmptrs[bch] = rbound;
      rbound->tfmnum = bch;
      adobechars[nglyphs] = rbound;
    }
    return;
  }
}

/* Reads a ligkern line, which may contain several ligkern specs.
 * lig_it = 0: only process rboundarychar spec
 * lig_it != 0: process all other ligkern specs
 * lig_it = 2: post-letterspacing; only `{}' specs are allowed.
 */
void checkligkern
P2C (char *, s, int, isencfile)
{
  char *mlist[5];               /* tokens constituting a ligkern spec */
  int n, i, bch;
  struct adobeinfo *ai;
  char *ll;

  ll = s;

  if (s[0] == '%')
    s++;           /* skip optional leading `%' */
  /* Note. '%' is necessary for ligkern comments in an encoding file
   * and optional otherwise.
   */
  while (*s && *s <= ' ')
    s++;           /* skip to first token */
  if (!s[0])
    return;        /* empty line; done */
  if (isencfile && strncmp (s, "LIGKERN", 7)) /* not a ligkern line */
    return;
  if (!strncmp (s, "LIGKERN", 7))
    s += 7;        /* skip beyond `LIGKERN' */
  sawligkern = 1;
  while (*s && *s <= ' ')
    s++;
  param = s;
  while (*param) {
    /* collect next ligkern spec */
    for (n = 0; n < 5;) {
      /* collect next token for ligkern spec */
      if (*param == 0)
        break;     /* ligkern spec complete */
      mlist[n] = paramstring ();
      if (strcmp (mlist[n], ";") == 0)
        break;     /* ligkern spec complete */
      n++;
    }

    /* handle ligkern spec */
    if (n > 4)
      error ("! too many parameters in lig kern data");
    if (n < 3)
      error ("! not enough parameters in lig kern data");
    if (n == 3 && strcmp (mlist[1], "{}") == 0) {
      if (!lig_it)
        continue;
      if (lig_it == 2 && strcmp (mlist[0], "*") != 0) {
        ai = findadobe (mlist[0]);
        if (ai) ai->nonstd_lk = 1;
      }
      rmkern (mlist[0], mlist[2]);
    } else if (n == 3 && strcmp (mlist[1], "<>") == 0) {
      if (!lig_it)
        continue;
      if (lig_it == 2)
        error ("!Post-letterspacing <> kern spec not allowed");
      copykerns (mlist[0], mlist[2]);
    } else if (n == 3 && strcmp (mlist[0], boundaryname) == 0 &&
               strcmp (mlist[1], "=") == 0) {
      /* setting of rboundarychar; only during 0-th iteration */
      if (lig_it)
        continue;
      if (lig_it == 2)
        error ("!Post-letterspacing boundarychar spec not allowed");
      if (rboundarychar != -1)
        error ("! multiple boundary character commands?");
      if (sscanf (mlist[2], "%d", &bch) == 1) {
        /* number for rboundarychar */
        if (bch < 0 || bch > 255)
          error ("! boundary character number must be 0..255");
        else
          set_rboundarychar (bch);
      } else {     /* named rboundarychar */
        for (bch = 0; bch < 256; bch++)
          if (!strcmp (outencoding->vec[bch], mlist[2]))
            break;
        if (bch<256) boundglyph = newstring(mlist[2]);
        else {
          if (strcmp ("cwm", mlist[2])) error
           ("unencoded boundarychar; will use empty slot instead");
          bch = -1;
          boundglyph = newstring(boundaryname);
        }
        set_rboundarychar (bch);
      }
    } else if (n == 4) {        /* ligature: char succ lig_op result */
      int op = -1;
      struct adobeinfo *ai;

      if (!lig_it)
        continue;
      if (lig_it == 2)
        error ("!Post-letterspacing lig spec not allowed");
      for (i = 0; encligops[i]; i++)
        if (strcmp (mlist[2], encligops[i]) == 0) {
          op = i;
          break;
        }
      if (op < 0)
        error ("! bad ligature op specified");
      if (!strcmp (mlist[0], boundaryname))
        ai = lbound;
      else
        ai = findadobe (mlist[0]);
      if (ai) {
        struct lig *lig;

        if (findadobe (mlist[1]))       /* remove coincident kerns */
          rmkern (mlist[0], mlist[1]);
        if (strcmp (mlist[3], boundaryname) == 0)
          error ("! you can't lig to the boundary character!");
        for (lig = ai->ligs; lig; lig = lig->next)
          if (strcmp (lig->succ, mlist[1]) == 0)
            break; /* we'll re-use this structure */
        if (lig == 0) {
          lig = newlig ();
          lig->succ = newstring (mlist[1]);
          lig->next = ai->ligs;
          ai->ligs = lig;
        }
        lig->sub = newstring (mlist[3]);
        lig->op = op;
        if (strcmp (mlist[1], boundaryname) == 0) {
          lig->boundright = 1;
          if (strcmp (mlist[0], boundaryname) == 0)
            error ("! you can't lig boundarychar boundarychar!");
        } else
          lig->boundright = 0;
      }
    } else
      error ("! bad form in LIGKERN command");
  }
}

void
letterspace ()
{
  int i,j;
  struct kern *k;
  struct adobeinfo *ai;
  int *haskern; /* which glyphs are rhs of a kerning pair? */

  haskern = (int *) malloc (nglyphs * sizeof (int));
  for (i=0;i<nglyphs;i++) {
    for (j=0;j<nglyphs;j++) haskern[j] = 0;
    ai = adobechars[i];
    for (k=ai->kerns;k;k=k->next) {
      j = findindex (k->succ);
      if (j>0 && j<nglyphs) {
        /* kern with rbound is NOT modified */
        k->delta += lspace;
        haskern[j] = 1;
      }
    }
    for (j=0;j<nglyphs;j++) if (!haskern[j]) {
      k = newkern();
      k->succ = adobechars[j]->adobename;
      k->delta = lspace;
      k->next = ai->kerns;
      ai->kerns = k;
    }
  }
  free (haskern);
  fontspace += 2 * lspace;
}

void
extraligkerninfo ()
{
  int i;
  char *p;
  struct adobeinfo *ai;

  /* with positive letterspacing, remove native ligs unless keepligs
   */
  if (lspace>0 && !keepligs)
    for (i=0;i<nglyphs;i++) adobechars[i]->ligs = NULL;

  /* Boundarychars make things a lot messier than they would be
   * otherwise. A rather long summary:
   * When typesetting, TeX sandwiches words between a left
   * boundarychar and a right boundarychar.
   * It seems sensible to translate space kerns into boundarychar
   * kerns although afm2tfm doesn't do this.
   * Below, we read ligkern info twice: the first time to read
   * a right boundarychar spec, if any, the second time to read everything
   * else. The global loop variable lig_it is consulted by checkligkern.
   * more about boundarychar/boundaryname:
   * rboundarychar is the index of right boundarychar in the tfm;
   * initialized as -1
   * The left boundarychar doesn't need a proper tfm index
   */
  if (lspace>0 && !strcmp (ligoption, "0")) ligoption = "1";
  if (!strcmp (ligoption, "0"))
    return;
  if (!strcmp (ligoption, "1") && encfilename && lspace<=0) {
    sawligkern = 0;
    /* ligkern specs in comments in encoding file? */
    encfilename =
      openin (encfilename, kpse_enc_format, ".enc");
    for (lig_it = 0; lig_it < 2; lig_it++) {
      while (getline ()) {
        /* search for (ligkern) comment in line */
        for (p = buffer; *p; p++)
          if (*p == '%') {
            checkligkern (p, 1);        /* 2nd param 1: reading .enc file */
            break;
          }
      }
      if (!sawligkern)
        break;     /* read default lig file instead */
      if (!lig_it) {
        if (rboundarychar == -1)
          set_rboundarychar (-1);
        rewind (infile);
      }
    }
    fclose (infile);
    if (sawligkern)
      return;
    else {
      ligfilenames->n = 1;
      ligfilenames->names = malloc (sizeof (char *));
      ligfilenames->names[0] = "default.lig";
    }
  } else if (!strcmp (ligoption, "1")) { /* lspace>0 or no encfile */
    ligfilenames->n = 1;
    ligfilenames->names = malloc (sizeof (char *));
    if (lspace<=0) ligfilenames->names[0] = "default.lig";
    else ligfilenames->names[0] = "defpre.lig";
  }

  /* process ligfilenames struct */
  for (lig_it = 0; lig_it < 2; lig_it++) {
    for (i = 0; i < ligfilenames->n; i++) {
      ligfilename = openin (ligfilenames->names[i],
                            kpse_lig_format, ".lig");
      while (getline ())
        checkligkern (buffer, 0);       /* 2nd param 0: lig file */
      fclose (infile);
    }
    if (!lig_it && (rboundarychar == -1))
      set_rboundarychar (-1);
  }

  /* optimization: identify glyphs which now have ligs or kerns.
   * Boundarychars: rboundarychar won't get a label in the ligtable,
   * and lboundarychar will be done separately anyhow.
   */
  for (i=0;i<nglyphs;i++) {
    ai = adobechars[i];
    ai->nonstd_lk = (ai->ligs!=NULL || ai->kerns!=NULL);
  }

  if (!lspace) return;

  letterspace();

  /* process post-letterspace ligfiles */
  if (!strcmp (Ligoption, "1")) {
    Ligfilenames->n = 1;
    Ligfilenames->names = malloc (sizeof (char *));
    Ligfilenames->names[0] = "defpost.lig";
  }
  lig_it = 2;
  for (i = 0; i < Ligfilenames->n; i++) {
    ligfilename = openin (Ligfilenames->names[i],
                          kpse_lig_format, ".lig");
    while (getline ())
      checkligkern (buffer, 0);       /* 2nd param 0: lig file */
    fclose (infile);
  }
}

void
  spaceparms
P1H (void)
{
  /* afm2tfm values for fstretch, fshrink, fextra: 200, 100, 111
   * fontinst values: 0.6 * space, 0.24 * space, ?
   * cmr10 values: 0.5 * space, .33 * space, .33 * space
   */
  if (!fixedpitch) {
    if (fstretch==0) fstretch = fontspace / 2;
    if (fshrink==0) fshrink = fontspace / 3;
    if (fextra==0) fextra = fontspace / 3;
  }
}

/*********************************************************
 * debug output of adobeinfo structs */

#ifdef AFMDEBUG
FILE *dmp;
char *dmpname = "afm2pl.dmp";

void dumpai
P1C (struct adobeinfo *, ai)
{
  struct lig *lg;
  struct kern *kr;
  putc ('\n', dmp);
  fprintf (dmp, "adobename %s\n",
           ai->adobename ? ai->adobename : "undefined");
  fprintf (dmp, "adobenum %d\n", ai->adobenum);
  fprintf (dmp, "tfmnum %d\n", ai->tfmnum);
  fprintf (dmp, "width %d\n", ai->width);
  fprintf (dmp, "bbox %d %d %d %d\n", ai->llx, ai->lly, ai->urx,
           ai->ury);
  fprintf (dmp, "nonstd_lk %d\n", ai->nonstd_lk);
  if (!ai->ligs)
    fputs ("no ligs\n", dmp);
  else
    for (lg = ai->ligs; lg; lg = lg->next)
      fprintf (dmp, "lig %s %d %s%s\n",
               lg->succ, lg->op, lg->sub,
               lg->boundright ? " boundarychar" : "");
  if (!ai->kerns)
    fputs ("no kerns\n", dmp);
  else
    for (kr = ai->kerns; kr; kr = kr->next)
      fprintf (dmp, "kern %s %d\n", kr->succ, kr->delta);
}

void writedump
P1H (void)
{
  int i;
  dmp = fopen (dmpname, "w");
  if (!dmp)
    error ("Cant open dump file");
  if (lbound) {
    fputs ("\nleft boundarychar\n", dmp);
    dumpai (lbound);
  }
  if (rbound) {
    fputs ("\nright boundarychar\n", dmp);
    dumpai (rbound);
  }
  for (i = 0; i < nglyphs; i++)
    if (adobechars[i]) dumpai (adobechars[i]);
    else fprintf (dmp, "\nNo char at slot %d\n", i);

  fputs ("\nBy tfmptrs:\n", dmp);
  for (i = 0; i < 256; i++)
    if (tfmptrs[i]) dumpai (tfmptrs[i]);
    else fprintf (dmp, "\nNo char at slot %d\n", i);
  fclose (dmp);
}
#endif

/*******************************************************************
 * the PL file. */

#define plout(s)  fprintf(outfile, s)
int level;                      /* depth of parenthesis nesting in PL output file */

/* indent */
void
pllevout ()
{
  register int l = level;
  while (l--)
    plout ("   ");
}

/* newline plus indent */
void
pllevnlout ()
{
  plout ("\n");
  pllevout ();
}

#define ploutln(str) {fprintf(outfile,"%s\n",str);pllevout();}
#define ploutln2(f,s) {fprintf(outfile,f,s);pllevnlout();}
#define ploutln3(f,a,b) {fprintf(outfile,f,a,b);pllevnlout();}
#define ploutln4(f,a,b,c) {fprintf(outfile,f,a,b,c);pllevnlout();}

/* left bracket */
void
  plleft
P1H (void)
{
  level++;
  plout ("(");
}

/* right bracket */
void
  plright
P1H (void)
{
  level--;
  ploutln (")");
}

/* return string representation for .pl file  of tfmptrs[c]
 * don't forget that TeX doesn't use glyph names.
 * only, if c happens to be a printable ascii char
 * then we gratefully use that fact if we are allowed to.
 * If the encoding moves the printable ascii range around then
 * forceoctal would be a good idea.
 */
char plcharbuf[6];
char *plchar
P1C (int, c)
{
  if (forceoctal == 0 && ISALNUM (c))
    (void) sprintf (plcharbuf, "C %c",
#ifndef VMCMS
                    c);
#else
                    ascii2ebcdic[c]);
#endif
  else
    (void) sprintf (plcharbuf, "O %o", (unsigned) c);
  return (char *) plcharbuf;
}

/* comment string with official glyph name if useful,
 * null string otherwise
 */
char plnamebuf[100];
char *plname
P1C (int, c)
{
  if (!forceoctal && ISALNUM (c)) {
    plnamebuf[0] = 0;
  } else if (c >= 0 && c < 256) {
    sprintf (plnamebuf, " (comment %s)", tfmptrs[c]->adobename);
  }
  return (char *) plnamebuf;
}


/* obuffer: originally unmodified copy of input buffer,
 * now recycled as output buffer
 */
void
  writepl
P1H (void)
{
  register int i, j, k;
  int bc, ec;
  register struct adobeinfo *ai;
  register struct lig *nlig;
  register struct kern *nkern;
  struct adobeinfo *asucc, *asub;
  int ht, dt;
  char labeled, *pp;

  outname = openout (outname, based_on, ".pl");

  /* header */
  pp = find_suffix (outname);
  if (pp) { pp--; *pp = 0; }
  (void) sprintf (obuffer, "%s%s%s", outname,
                  (efactor == 1.0 ? "" : "-E"),
                  (slant == 0.0 ? "" : "-S"));
  if (strlen (obuffer) > 19) {  /* too long, will retain first 9 and last 10 */
    register char *p, *q;
    for (p = &obuffer[9], q = &obuffer[strlen (obuffer) - 10];
         p < &obuffer[19]; p++, q++)
      *p = *q;
    obuffer[19] = 0;
  }

  /* global parameters */
  ploutln2 ("(FAMILY %s)", obuffer);
  {
    char tbuf[41];
    char *tbp;

    strncpy (tbuf, outencoding->name, 40);
    tbuf[40] = 0;

    if (strlen (tbuf) > 39) {
      error ("Coding scheme too long; shortening to 39 characters.");
      tbuf[39] = 0;
    }
    tbp = tbuf;
    while (*tbp) { *tbp = toupper (*tbp); tbp++; }
    ploutln2 ("(CODINGSCHEME %s)", tbuf);
  }
  ploutln ("(DESIGNSIZE R 10.0)");
  ploutln ("(DESIGNUNITS R 1000)");
  ploutln ("(COMMENT DESIGNSIZE (1 em) IS IN POINTS)");
  ploutln
    ("(COMMENT OTHER DIMENSIONS ARE MULTIPLES OF DESIGNSIZE/1000)");
  /* Let pltotf compute the checksum. */
  /* ploutln2("(CHECKSUM O %lo)",cksum ^ 0xffffffff) ; */
  if (rboundarychar >= 0)
    ploutln2 ("(BOUNDARYCHAR O %lo)", (unsigned long) rboundarychar);
  plleft ();
  ploutln ("FONTDIMEN");
  ploutln2 ("(SLANT R %f)", newslant);
  ploutln2 ("(SPACE D %d)", fontspace);
  ploutln2 ("(STRETCH D %d)", fstretch);
  ploutln2 ("(SHRINK D %d)", fshrink);
  ploutln2 ("(XHEIGHT D %d)", xheight);
  ploutln2 ("(QUAD D %d)", fquad);
  if (!afm2tfm_compat) ploutln2 ("(EXTRASPACE D %d)", fextra);
  plright ();

  /* beginning and end of char array */
  for (i = 0; i < 256 && tfmptrs[i] == NULL; i++);
  bc = i;
  for (i = 255; i >= 0 && tfmptrs[i] == NULL; i--);
  ec = i;

  /* ligkern table */
  plleft ();
  ploutln ("LIGTABLE");

  /* (left) boundarychar ligskerns */
  ai = lbound;
  labeled = 0;
  for (nlig = ai->ligs; nlig; nlig = nlig->next)
    if (0 != (asucc = findtfm (nlig->succ)))
      if (0 != (asub = findtfm (nlig->sub))) {
        if (!labeled) {
          ploutln ("(LABEL BOUNDARYCHAR)");
          labeled = 1;
        }
        /* handle all encodings of asucc */
        for (k = asucc->tfmnum; k >= 0; k = tfmnext[k])
          ploutln4 ("(%s %s O %o)", plligops[nlig->op],
                    plchar (k), (unsigned) asub->tfmnum);
      }
  for (nkern = ai->kerns; nkern; nkern = nkern->next)
    if (0 != (asucc = findtfm (nkern->succ))) {
      if (!labeled) {
        ploutln ("(LABEL BOUNDARYCHAR)");
        labeled = 1;
      }
      /* handle all encodings of asucc */
      for (k = asucc->tfmnum; k >= 0; k = tfmnext[k]) {
        ploutln4 ("(KRN %s R %d)%s", plchar (k),
                  nkern->delta, plname (k));
      }
    }
  if (labeled)
    ploutln ("(STOP)");

  /* other ligs and kerns */


  for (i = bc; i <= ec; i++)
    if ((ai = tfmptrs[i]) && ai->tfmnum == i && ai->nonstd_lk) {
      /* slot i is filled, points to a not-previously-encoded
       * character, and has ligs and kerns other than
       * standard letterspacing kerns. Do right boundarychar
       * only if it is a real glyph.
       */
      if (!strcmp (ai->adobename, "||"))
        continue;
      labeled = 0;
      /* do ligatures for ai = tfmptrs[i] */
      for (nlig = ai->ligs; nlig; nlig = nlig->next)
        if (0 != (asucc = findtfm (nlig->succ)))
          if (0 != (asub = findtfm (nlig->sub))) {
            /* we found a lig which really belongs in the tfm */
            if (!labeled) {
              /* also take care of all other slots for this char */
              for (j = i; j >= 0; j = tfmnext[j]) {
                ploutln3 ("(LABEL %s)%s", plchar (j), plname (j));
              }
              labeled = 1;
            }
            for (k = asucc->tfmnum; k >= 0; k = tfmnext[k]) {
              ploutln4 ("(%s %s O %o)", plligops[nlig->op],
                        plchar (k), (unsigned) asub->tfmnum);
            }
          }
      /* do kerns for ai = tfmptrs[i] */
      for (nkern = ai->kerns; nkern; nkern = nkern->next)
        if (0 != (asucc = findtfm (nkern->succ))) {
          if (!labeled) {
            for (j = i; j >= 0; j = tfmnext[j]) {
              ploutln3 ("(LABEL %s)%s", plchar (j), plname (j));
            }
            labeled = 1;
          }
          dt = nkern->delta;
          for (k = asucc->tfmnum; k >= 0; k = tfmnext[k]) {
            ploutln4 ("(KRN %s R %d)%s", plchar (k), dt, plname (k));
          }
        }
      if (labeled)
        ploutln ("(STOP)");
    }

  if (lspace) {
    for (i = bc; i <= ec; i++)
      if ((ai = tfmptrs[i]) && !ai->nonstd_lk) {
        /* do all 'standard' glyphs together.
         * no need to check for ligatures.
         * we do check for kerns, though:
         * if there are none, then apparently all space kerns
         * have been tossed out, and there is nothing to do.
         * Either way, we break out of the loop after doing the
         * first glyph with `standard' ligkerns.
         */
      if (!strcmp(ai->adobename,"||")) continue;
      if (!ai->kerns) break;
      for (j = i; j <= ec; j++) if (tfmptrs[j] && !tfmptrs[j]->nonstd_lk)
        ploutln3 ("(LABEL %s)%s", plchar (j), plname (j));
      for (nkern = ai->kerns; nkern; nkern = nkern->next)
        if (0 != (asucc = findtfm (nkern->succ))) {
          dt = nkern->delta;
          for (k = asucc->tfmnum; k >= 0; k = tfmnext[k])
            ploutln4 ("(KRN %s R %d)%s", plchar (k), dt, plname (k));
        }
      ploutln ("(STOP)");
      break;
    }
  }

  plright ();

  /* done with ligkerns; now char metrics */
  for (i = bc; i <= ec; i++)
    if (0 != (ai = tfmptrs[i])) {
      if (!strcmp (ai->adobename, "||"))
        continue;
      plleft ();
      fprintf (outfile, "CHARACTER %s", plchar (i));
      if (*plcharbuf == 'C') {
        ploutln ("");
      } else
        ploutln2 (" (comment %s)", ai->adobename);
      ploutln2 ("(CHARWD R %d)", ai->width);
      if (0 != (ht = ai->ury))
        ploutln2 ("(CHARHT R %d)", ht);
      if (ai->lly)
        ploutln2 ("(CHARDP R %d)", -ai->lly);
      if (ai->urx > ai->width)
        ploutln2 ("(CHARIC R %d)", ai->urx - ai->width);
      plright ();
    }
  if (level)
    error ("! I forgot to match the parentheses");
  fclose (outfile);
}

/*******************************************************************
 * (version and) usage
 */
void version
P1C (FILE *, f)
{
#ifdef KPATHSEA
  extern KPSEDLL char *kpathsea_version_string;
#endif
  fputs ("afm2pl(k) 0.7.03\n", f);
#ifdef KPATHSEA
  fprintf (f, "%s\n", kpathsea_version_string);
#endif
  fputs ("Copyright (C) 2002, 2005 Siep Kroonenberg.\n\
This program is derived from afm2tfm, (C) 2002 Radical Eye Software.\n\
There is NO warranty.  You may redistribute this software\n\
under the terms of the GNU General Public License.\n\
For more information about these matters, see the files\n\
named COPYING and afm2pl.c.\n", f);
}

#define USAGE "\
Convert an Adobe font metric file to a TeX font property list.\n\
\n\
-p ENCFILE          Read/download ENCFILE for the PostScript encoding\n\
-o                  Use octal for all character codes in the pl file\n\
-e REAL             Widen (extend) characters by a factor of REAL\n\
-s REAL             Oblique (slant) characters by REAL, generally <<1\n\
-m INTEGER          Letterspace by INTEGER/1000 em\n\
-V                  Verbose output; i.e. report on missing glyphs\n\
--help              Print this message and exit.\n\
--version           Print version number and exit.\n\n\
See the man page for full documentation.\n\n\
"

void afm2pl_usage
P1C (FILE *, f)
{
  fputs ("Usage: afm2pl [OPTIONS]... FILE[.afm] [FILE[.pl]]\n", f);
  fputs (USAGE, f);
  fputc ('\n', f);
  fputs ("Email bug reports to ntg-afm2pl@ntg.nl\n", f);
}

/**************************************************************
 * parse commandline
 */

/* decode comma-separated list of non-negative integers.
 * initialize everything to -1 i.e. undefined
*/
int getnums
P3C (char *, st, int *, nums, int, num)
{
  char *p; /* pointer into st */
  int curnum, curindex, ndigits;
  /* curnum: number to be parsed
     curindex: index for nums array
     ndigits: n. of digits found for curnum
  */
  for (curindex=0;curindex<num;curindex++) {
    nums[curindex] = -1;
  }
  for (curnum=0,curindex=0,ndigits=0,p=st;;p++) {
    if (*p==',' || *p==0) {
      /* done with this number */
      if (ndigits>0) /* we found some digits */
        nums[curindex] = curnum;
      curnum = 0;
      curindex++;
      ndigits = 0;
      if (curindex>=num || !*p) break;
    } else if (*p>='0' && *p<='9') {
      curnum = 10*curnum + (*p-'0');
      ndigits++;
    } else {
      error ("! Illegal -f parameter");
    }
  }
  if (!*p) return 1; /* end of string reached: no problems */
  else return 0;
}

/* split string on commas into strings; disregard empty strings */
struct nstrings *getoutnames
P2C (char *, st, struct nstrings *, onames)
{
  char *argcopy;
  unsigned i;
  int j, inpart;
  argcopy = (char *) malloc (strlen (st) + 1);
  strcpy (argcopy, st);
  inpart = 0;      /* cursor not inside a constituing substring */
  for (i = 0, onames->n = 0; i < strlen (st); i++) {
    if (argcopy[i] == ',') {
      argcopy[i] = 0;
      inpart = 0;
    } else if (!inpart) {
      inpart = 1;
      onames->n++;
    }
    /* !=',', inpart: do nothing */
  }
  onames->names = (char **) malloc (onames->n * sizeof (char *));
  inpart = 0;
  for (i = 0, j = 0; i < strlen (st); i++) {
    if (argcopy[i] == 0)
      inpart = 0;
    else if (!inpart) {
      onames->names[j++] = argcopy + i;
      inpart = 1;
    }
  }
  return onames;
}

/* call this when an option requires an argument */
#define CHECKARG3 if (argc < 3) { afm2pl_usage(stderr); exit(1); }

void
  readargs
P2C (int, argc, char **, argv)
{
  register int i;
  int fdims[3];

  /* skip argv[0] and look at the rest. */
  argv++;
  argc--;

  if (argc == 0 || (argc > 0 && (!strcmp (argv[0], "--help") ||
    !strcmp (argv[0], "-help")) || !strcmp (argv[0], "-h"))) {
    afm2pl_usage (stdout);
    exit (0);
  }

  if (!strcmp (argv[0], "--version") ||
    !strcmp (argv[0], "-version") || !strcmp (argv[0], "-v")) {
    version (stdout);
    exit (0);
  }

  /* allocate structs for ligkern filenames */
  ligfilenames = (struct nstrings *) mymalloc
    ((unsigned long) sizeof (struct nstrings));
  Ligfilenames = (struct nstrings *) mymalloc
    ((unsigned long) sizeof (struct nstrings));

  /* looping: advance argv and decrement argc to match unprocessed
   * command-line arguments.
   * After the options, we need at least an afm filename,
   * which will be handled AFTER this loop.
   */

  while (argc > 0 && *argv[0] == '-') {
    i = argv[0][1];
    /* I don't understand what this is about.
     * The comment below suggests that it is VM/CMS-specific
     * so I comment it out for other OS-es. [SK]
     */
#ifdef VMCMS
    if (i == '/')
      i = argv[0][2] - 32;      /* /a ==> A for VMS */
#endif
    switch (i) {
    case 'e':
      efactor = 1.0;
      CHECKARG3
        if (sscanf (argv[1], "%f", &efactor) == 0 || efactor < 0.01)
        error ("! Bad extension factor");
      efactorparam = argv[1];
      argv += 2;
      argc -= 2;
      break;
    case 's':
      CHECKARG3 if (sscanf (argv[1], "%f", &slant) == 0)
        error ("! Bad slant parameter");
      slantparam = argv[1];
      argv += 2;
      argc -= 2;
      break;
    case 'm':
      CHECKARG3 if (sscanf (argv[1], "%d", &lspace) == 0)
        error ("! Bad letterspacing parameter");
      lspaceparam = argv[1];
      if (lspace > 0)
        keepligs = 0;
      argv += 2;
      argc -= 2;
      break;
    case 'p':
      CHECKARG3 encfilename = argv[1];
      argv += 2;
      argc -= 2;
      break;
    case 'f':
      CHECKARG3
      if (!strcmp (argv[1], "afm2tfm")) {
        afm2tfm_compat = 1;
      } else if (!strcmp (argv[1], "afm2tfm")) {
        afm2tfm_compat = 1;
      } else {
        if (!getnums (argv[1], fdims, 5))
          error ("!Parsing error in argument of -f");
        fstretch = fdims[0]; fshrink = fdims[1]; fextra = fdims[2];
        fquad = fdims[3]; fontspace = fdims[4];
      }
      argv += 2;
      argc -= 2;
      break;
    case 'l':
      CHECKARG3 ligoption = argv[1];
      if (strcmp (ligoption, "0") && strcmp (ligoption, "1")) {
        getoutnames (ligoption, ligfilenames);
      }
      argv += 2;
      argc -= 2;
      break;
    case 'L':
      CHECKARG3 Ligoption = argv[1];
      if (strcmp (Ligoption, "0") && strcmp (Ligoption, "1")) {
        getoutnames (Ligoption, Ligfilenames);
      }
      argv += 2;
      argc -= 2;
      break;
    case 'o':
      forceoctal = 1;
      argv += 1;
      argc -= 1;
      break;
    case 'k':
      keepligs = 1;
      argv += 1;
      argc -= 1;
      break;
    case 'V':
      verbose = 1;
      argv += 1;
      argc -= 1;
      break;
    default:
      (void) fprintf (stderr,
                      "Unknown option %s %s will be ignored.\n",
                      argv[0], argv[1]);
      argv += 2;
      argc -= 2;
    }
  }

  /* end of loop. Remainder: name of afm file and possibly pl file */
  afmname = argv[0];

  if ((argc < 1) || (argc > 2)) {
    error ("! need one or two non-option arguments");
    afm2pl_usage (stderr);
  }

  if (argc == 1) {
    outname = afmname;
    based_on = 1;
  } else {
    outname = argv[1];
    based_on = 0;
  }
}

/* This routine prints out the line that needs to be added to psfonts.map.
 */
void
conspsfonts ()
{
  char *base, *p, *q;

  /* TeX fontname is file basename without path or extension */
  p = newstring (outname);
  base = (char *)xbasename (p);
  q = find_suffix (base);
  if (q > base) {
    q--;
    *q = 0;
  }
  openout (base, 0, ".map");
  (void) fprintf (outfile, "%s %s", base, fontname);
  if (slantparam || efactorparam || encfilename) {
    (void) fprintf (outfile, " \"");
    if (slantparam)
      (void) fprintf (outfile, " %s SlantFont", slantparam);
    if (efactorparam)
      (void) fprintf (outfile, " %s ExtendFont", efactorparam);
    if (encfilename)
      (void) fprintf (outfile, " %s ReEncodeFont", outencoding->name);
    (void) fprintf (outfile, " \"");
    if (encfilename) {
      base = (char *)xbasename (encfilename);
      (void) fprintf (outfile, " <%s", base);
    }
  }
  p = newstring (afmname);
  base = (char *)xbasename (p);
  q = find_suffix (base);
  if (q > base) {
    q--;
    *q = 0;
  }
  (void) fprintf (outfile, " <%s.pfb", base);
  (void) fprintf (outfile, "\n");
  fclose (outfile);
}

/********************************************************
 * main program
 */

#ifndef VMS
int
#endif
  main
P2C (int, argc, char **, argv)
{

#ifdef KPATHSEA
  kpse_set_program_name (argv[0], "afm2pl");

  if (argc == 1) {
    fputs ("afm2pl: Need at least one file argument.\n", stderr);
    fputs ("Try `afm2pl --help' for more information.\n", stderr);
    exit (1);
  }
  if (argc == 2) {
    if (strcmp (argv[1], "--help") == 0) {
      afm2pl_usage (stdout);
      exit (0);
    } else if (strcmp (argv[1], "--version") == 0) {
      version (stdout);
      exit (0);
    }
  }
#endif /* KPATHSEA */
  readargs (argc, argv);
  readadobe ();
  changeadobe ();
  readencoding ();
  extraligkerninfo ();  /* loop over lig files and lines in lig files */
  spaceparms ();
#ifdef AFMDEBUG
  writedump ();
#endif
  writepl ();
  conspsfonts ();
  return -missingchars;
}
