/*=======================================================================
    www/src/makelogob.c
    Version of makelogo.c for use with getblock function of the blocks
    WWW server. Modified to accept an argument which it uses as a suffix
    for input files symvec.suffix colors.suffix and makelogop.suffix 
    (created by matrix_logo program) and output file logo.suffix  (JGH)
	Requires p2clib 
2/16/95 Jorja Henikoff
Feb 27, 95 - modified to use colors.suffix (instead of colors) SP 
4/1/95  Added Adobe PostScript structuring comments to avoid problems
        with some browsers (%% lines). Also increased maxstring from
        150 to 1500 to accomodate global alignments.   JGH
2/2/00  Never print the right-hand bar (look for endline & barends)
=========================================================================*/
/* Output from p2c, the Pascal-to-C translator */
/* From input file "makelogo.p" */

/* function labs (long [?] absolute number) changed to abs, since labs was not 
   available on math library in howard.fhcrc.org . */ 

#include "p2c.h"

/* makelogo: make a graphical `sequence logo' for aligned sequences
  by Thomas Schneider
  NCI/FCRDC Bldg 469. Room 144
  P.O. Box B
  Frederick, MD  21702-1201
  (301) 846-5581 (-5532 for messages)
  (301) 846-5598 fax
  network address: toms@ncifcrf.gov

module libraries required: delman, prgmods */

/* end of program */

/* begin module version */

#define version         7.64
/* of makelogo.p 1994 July 8
origin 1990 Feb 28 from rsgra */
/* end module version */

/* begin module describe.makelogo */
/*
name
   makelogo: make a graphical `sequence logo' for aligned sequences

synopsis
   makelogo(symvec: in, makelogop: in, colors: in, marks: in,
            wave: in, logo: out, output: out)

files
   symvec: A "symbol vector" file from the alpro or dalvec program.
     If the file is empty, the alphabet is printed.  This allows one
     to determine the correction factors described below.
     If the error bars have a negative size, they are not displayed.
     This allows the sites program to control the display when it
     would not be appropriate.
     If the number of a symbol is negative in symvec, then the
     symbol will be rotated 180 degrees before being printed.
     The absolute value is used by makelogo to determine the height.
     This allows statistical tests which find rare symbols to be
     significant to show that the symbol is rare by having
     it up side down.  Notice that ACGT are all easy to distinguish
     from their upside down versions, but unfortunately this is not always
     true for protein sequences.

   makelogop: parameters to control the program.
     line 1: contains the lowest to highest range of the binding
             site to do the logo graph. (FROM to TO range)
     line 2: bar: sequence coordinate before which to print a vertical bar
             NOTE: the vertical bar takes up a small amount of horizontal space.
             This will offset the logo from that point on by a tiny amount.
     line 3: xcorner and ycorner.  This is the coordinate of the
             lower left hand corner of the logo (in cm).
             These should be real numbers.
     line 4: rotation: angle in degrees to rotate the logo.  Warning:
             rotations other than by factors of 90 degrees may produce
             incorrect logos because character scaling depends on the
             orientation of the characters.  (Essentially, it's a design
             fault of PostScript.)
     line 5: charwidth: (real, > 0) the width of the logo characters, in cm
     line 6: barheight barwidth: (real, > 0) height of the vertical bar, in cm,
             and its width, in cm.
     line 7: barbits: (real) The height of the vertical bar, in bits, is given
             by the absolute value of barbits.  If barbits is positive, an
             "I-beam" will appear at the top of the symbol stack.  The I-beam
             indicates one standard deviation of the stack height, based
             entirely on how small the sample of sequences is.  If the value of
             barbits is negative, the I-beam is not displayed.  Not knowing how
             big the sampling effects are can fool one, so one should usually
             have the I-beam, even if it is ugly.
                WARNING: it is not known how to calculate the error for data
             derived from a dirty DNA synthesis experiment (see Schneider1989,
             reference given below).  In that case the error could be
             calculated (in program sites) from the number of sequences, so
             that the error bar would be an underestimate of the variation.
             Unfortunately, when I tried this, people interpreted the error bar
             as the size they saw, so this does not work well visually.
             Therefore when data come from the sites program, the I-beam is
             suppressed.
                The combination of barheight and barbits determines the size of
             the logo in bits per centimeter.  Both must be specified even if
             no vertical bar is desired.
     line 8: Ibeamfraction: real. The fraction of the vertical part of the
             Ibeam to draw.  When it is 1, the Ibeam is normal.  When it is
             zero, no vertical line is drawn.  At 0.1, only 10 percent of the
             top half and 10 percent of the bottom half of the Ibeam is drawn,
             for a total of 10 percent of the entire ibeam.  More precisely,
             this number is the fraction of a standard deviation to draw.
             Negative values will reverse the direction of the part drawn,
             making a 'thumbtack'.  (Note:  if this parameter is missing, as in
             old makelogop files, the program will ignore it.)  I thank Shmuel
             Pietrokovski (Structural Biology department, Weizmann Institute of
             Science, 76100 Rehovot - ISRAEL, bppietro@dapsas1.weizmann.ac.il)
             for suggesting this method, and for the code to do it.  See
             further description below.
     line 9: barends: if the first character on the line is a 'b', then bars
             are put before and after each line, in addition to the other bar.
             The first bar on each line is labeled with tic marks and
             the number of bits.  If you don't want this, you can remove
             the call to maketic in the logo.
    line 10: showingbox: if the first character on the line is an 's',
             then show a dashed box around each character.
    line 11: outline: If the first character is 'o' then the characters show
             up in outline form.  Otherwise, they are solid.
    line 12: caps: if the first letter is 'c' then alphabetic
             characters are converted to capital form.
    line 13: stacksperline: number of character stacks per line output.
             A "stack" is a vertical set of characters.  A "line" is a series
             of stacks.  One may have several lines per page (next parameter).
             Special note: This value is used to do the centering of strings.
             For a range of -23 to +19, you have to set it to (19)-(-23)+1 = 43
             to get your title centered correctly.  You can get the program to
             tell you the number '43' by setting stacksperline very large, in
             which case it realizes there is something wrong and does the
             calculation.
    line 14: linesperpage: number of lines per page output
    line 15: linemove: line separation relative to the barheight
    line 16: numbering: if the first letter is 'n' then each stack is
             numbered.  Otherwise, the number is suppressed as a PostScript
             comment.  This allows you to modify the logo file by hand to
             reinstate numbering for only the positions you want by removing
             the percent (%) symbol from in front of the calls to makenumber.
    line 17: shrinking: (real)  Factor by which to shrink the characters.  If
             shrinking <= 0 or shrinking >= 1 then the characters exactly fit
             into the dashed box.  If shrinking > 0 and shrinking < 1, the
             characters are shrunk inside the dashed box.  To use this feature,
             the parameter showningbox be on, so that the user does not create
             a logo whose height is misleading.
    line 18: strings: the number of user defined strings to follow.  Each
             string definition takes up two lines.  The first is the (x,y)
             coordinate of the string, the second is the string itself.  The
             coordinates are in centimeters relative to the coordinate
             transforms performed above.  (This way, the title position stays
             the same relative to the logo.)
    line 19: (x,y,s) coordinates of first user defined string (if strings >= 1)
             followed by the factor by which to scale the string.  A factor
             of 1 means no scaling.  In addition, if the x coordinate is
             negative, then the string is centered by using the string
             width, the stacksperline and charwidth.
    line 20: the first user defined string (if strings >= 1)
    line 21: (x,y,s) coordinates of second user defined string (if strings >= 2)
    line 22: the second user defined string (if strings >= 2)
             (etc. for the remaining strings.)
    The remainder of the file is ignored and may contain comments.

   colors: Defines the color of each character printed.
     Any number of lines that begin with an asterisk [*] can be used
     as comments to identify the file or portions of the file.
     Put into the file one line for each character that is to
     have a color other than black.  The line must contain:
                    character red green blue
     The last three parameters are real values between 0 and 1 (inclusive).
     The values depend on the PostScript interpreter, but 0 means black
     and a value of 1 means the most bright.
     To assign the asterisk a color, proceed it with a backslash [as \*].
     To assign the backslash a color, proceed it with a backslash [as \\].
     If the file is empty, the logo is made in black and white and the lower
     half of the I-beam error bar is made white so that when it is inside the
     letters it is visible.

   marks: an empty file means no marks are made.  Otherwise, a series
     of lines containing four pieces of data that define marks to be placed
     over the output:
        mark: o means open circle, f means filled circle.
        base coordinate: a real number that determines the center of the mark
        bits coordinate: a real number that determines the position of the
           mark in bits.
        scale: a positive real number by which to scale the mark.
     The symbols must be in increasing order of position in the site.

   wave: Define a cosine wave over the graph.  Empty file means no cosine
     wave, otherwise the parameters of the wave are given one per line:
       extreme: char;  h or l, the extreme high or low point on the curve
          defined by the wavelocation and wavebit
       wavelocation: real; the location in bases of the extreme
       wavebit: real; the location in bits of the extreme
       waveamplitude: real; the amplitude of the wave in bits
       wavelength: real; the wave length of the wave in bases
       dash: real; the size of dashes in cm.  Zero or negative means no dashes
       thickness: real; thickness of the wave in cm.  Zero or negative
          means the value defaults to PostScript line thickness.

   logo: the output file, a PostScript program to display the logo.

   output: messages to the user

description
   The makelogo program generates a `sequence logo' for a set of aligned
   sequences.  A full description is in the documentation paper.  The input is
   an `symvec', or symbol-vector that contains the information at each
   position and the numbers of each symbol.  The output is in the graphics
   language PostScript.

   The program now indicates the small sample error in the logo by a small
   'I-beam' overlayed on the top of the logo.  Although the user may
   turn this off to make pretty logos, I strongly recommend use of it
   to avoid being fooled by small amounts of data.

   Making A Logo As Part of Another Figure
   ---------------------------------------

   The normal logo file is designed to stand by itself.  However, it is often
   desirable to incorporate the logo as part of another figure.  The difficulty
   is that the stand-alone logo PostScript program will erase the page (which
   wipes out any previous figure drawing) and show the page (which prints the
   page right after the logo).  To prevent these actions, the lines of
   PostScript code which do this have comments that contain the word REMOVE.
   All you have to do is remove these lines and your logo will be able to fit
   into your figure.  In Unix this can be easily done by:

   grep -v REMOVE logo > logo.ps

   If you do this, then it is advisable to do the erasepage and the
   showpage yourself.  A convenient way to do this is to have several
   files that contain postscript commands, and to use a shell script
   to concatenate them together:

   cat start.ps logo.ps end.ps > myfigure.ps

   If you have a large number of logos together in one figure, you can reduce
   the size of the final figure by another trick.  Logo files begin with a
   header which is the same from one figure to the next assuming you don't
   change colors/letter combinations.  So the first logo in the figure must
   contain this header, but later ones don't really need it.  You can remove
   the header material by using the censor program:

   censor < logo.ps > logo.no.header.ps

   Playing with Ibeams
   -------------------
   Shmuel Pietrokovski (bppietro@dapsas1.weizmann.ac.il) suggested that the
   middle of the Ibeams be removable so that it doesn't get in the way of
   logos.  That is, a normal Ibeam looks like:

   -----
     |
     |
     |
     |
     |
     |
   -----

   This is sitting on the top of the sequence logo stack of letters.  This is
   obtained by setting the Ibeamfraction to 1.0.  Shmuel suggested that there be
   a parameter to remove the vertical part or to have it partway:

   -----
     |
     |


     |
     |
   -----

   This is obtained by setting the Ibeamfraction to 0.6.  Setting Ibeamfraction
   to -1.0, puts the vertical parts OUTSIDE the bars.  This way one can read
   one standard deviation of the stack and also have a mark at (for example) 2
   standard deviations out at the tips of the thumb tacks:

     |
     |
   -----


   -----
     |
     |

author
   Thomas D. Schneider
   National Cancer Institute
   Laboratory of Mathematical Biology
   NCI/FCRDC Bldg 469. Room 144
   P.O. Box B
   Frederick, MD  21702-1201
   (301) 846-5581 (-5532 for messages)
   email: toms@ncifcrf.gov

examples
   makelogop parameters:

-15 2      FROM to TO range to make the logo over
1          sequence coordinate before which to put a bar on the logo
15 2       (xcorner, ycorner) lower left hand corner of the logo (in cm)
90         rotation: angle to rotate the graph
1.0        charwidth: (real, > 0) the width of the logo characters, in cm
10 0.1     barheight, barwidth: (real, > 0) height of vertical bar, in cm
2          barbits: (real) height of the vertical bar, in bits; < 0: no I-beam
no bars    barends: if 'b' put bars before and after each line
show       showingbox: if 's' show a dashed box around each character
no outline outline: if 'o' make each character as an outline
100        stacksperline: number of character stacks per line output
1          linesperpage: number of lines per page output
1.1        linemove: line separation relative to the barheight
numbers    numbering: if the first letter is 'n' then each stack is numbered
1          shrinking: factor by which to shrink characters inside dashed box
2          strings: the number of user defined strings to follow
2 14 1     coordinates of the first string (in cm)
First TITLE
3 13 1     coordinates of the second string (in cm)
SECOND TITLE

   colors:
* Color scheme for logos of DNA (for the makelogo program).
* color order is red-green-blue
*
* green:
A 0 1 0
a 0 1 0
*
* blue:
C 0 0 1
c 0 0 1
*
* red:
T 1 0 0
t 1 0 0
*
* orange:
G 1 0.7 0
g 1 0.7 0

   wave:
l        extreme: char; h or l, the high or low extreme to be defined
2        wavelocation: real; the location in bases of the extreme
1.0      wavebit: real; the location in bits of the extreme
0.5      waveamplitude: real; the amplitude of the wave in bits
10.4     wavelength: real; the wave length of the wave in bases
0        dash: real; the size of dashes in cm.  dash <= 0 means no dashes
0.1      thickness: real; thickness of the wave in cm. <=0: default.

  A test symvec is provided with the program, file 'symvec.demo', to be run with
  'colors.demo' and 'makelogop.demo'.

documentation
   Description of Logos:
@article{Schneider.Stephens.Logo,
author = "T. D. Schneider
 and R. M. Stephens",
title = "Sequence Logos: A New Way to Display Consensus Sequences",
journal = "Nucl. Acids Res.",
volume = "18",
pages = "6097-6100",
year = "1990"}

   The Blue Book:
@book{PostScriptTutorial1985,
author = "{Adobe Systems Incorporated}",
title = "PostScript Language Tutorial and Cookbook",
publisher = "Addison-Wesley Publishing Company",
address = "Reading, Massachusetts",
callnumber = "QA76.73.P67P68",
isbn = "0-201-10179-3",
year = "1985"}

   The Red Book:
@book{PostScriptManual1985,
author = "{Adobe Systems Incorporated}",
title = "PostScript Language Reference Manual",
publisher = "Addison-Wesley Publishing Company",
address = "Reading, Massachusetts",
callnumber = "QA76.73.P67P67",
isbn = "0-201-10174-2",
year = "1985"}

   Dirty DNA synthesis experiments:
@article{Schneider1989,
author = "T. D. Schneider
 and G. D. Stormo",
title = "Excess Information at Bacteriophage {T7} Genomic Promoters
Detected by a Random Cloning Technique",
year = "1989",
journal = "Nucl. Acids Res.",
volume = "17",
pages = "659-674"}

see also
   rsgra.p, rseq.p, dalvec.p, alpro.p, sites.p, censor.p

bugs
   Some chi-logo (upside down characters) do not display on OpenWindows,
   but do print ok on the Apple LaserWriter IIntx.  The reason is completely
   obscure.

   A bug in NeWS 1.1 is that characters that are scaled too small are
   forced to be big.  This messes up the logo and can be confusing.
   Another bug in NeWS 1.1 prevents one from using the outline, but
   the dashed boxes will show up.
   Sometimes displaying a logo in NeWS 1.1 on a Sun 4 will cause an 'illegal
   instruction', after which one is thrown completely off the computer.  The
   source of this is not known, since it is not repeatable.
   The first two bugs are resolved under OpenWindows 2; the third has not
   been observed.
   These NeWS bugs do not apply to the Apple LaserWriter IIntx,
   which prints everything correctly.

technical notes
   Unfortunately PostScript fonts are not exactly the same height.  Thus if A
   and T are the standard, then C and G hang above and below the line.
   This has been solved in this version of makelogo.  As a consequence,
   the user never need to determine any character sizes empirically, and
   the logos should work on any PostScript printer.

   Special thanks go to the following people for their help in solving this
   problem:

   Kevin Andresen [kevina@apple.com]
   "The problem facing you is that, while the PostScript language is more or
   less standard, the font shapes depend on the designer, type vendor, or
   language implementation.  The fonts used in NeWS are not exactly the same
   as those from Adobe, which are not the same as those from Bitstream, which
   are not the same as the original lead type, etc.  (This is an
   industry-wide issue.)  One way to compensate for this in PostScript is to
   use the charpath and pathbbox operators and scale appropriately."

   He provided a program, which I then rewrote and generalized.  That version
   almost worked, but not quite.  This was solved by:

   finlay@Eng.Sun.COM (John Finlay) who said:
   "It would appear that the calculation of the pathbbox for characters varies
   with the scale of the characters (I don't know why exactly but would
   speculate that there's probably some weirdness with the font hints and
   scaling).  I modified your postscript to iterate once on the size and
   recalculate the pathbbox at the scaled size.  Seems to printout OK (inside
   the boxes) on a LWI, LWII and in NeWS2.0 (though NeWS still seems to get the
   wide slightly wrong)."

   shiva@well.sf.ca.us (Kenneth Porter) was also involved and actively
   interested.  My apologies if I have forgotten someone else who contributed.

   The letter I and the vertical bar (|) are treated specially since in the
   Helvetica-Bold font they are rectangles and would completely fill the
   character space.  In addition, the letter I is centered by makelogo.

   Thanks go to Joe Mack for suggesting numbering and titles (strings) and to
   Pete Lemkin and Wojciech Kasprzak for pointing out that the shrink option
   would be helpful.  Thanks to Jeff Haemer for pointing out that the
   PostScript program should begin with '%!', and for suggesting that
   the string fonts should be different from the logos themselves.

   MISSING LOGO LETTER PROBLEM

   The OpenWindows PostScript on a Sun workstation will mess up displaying a
   stack of letters if the vertical movement is too small.  The result is that
   the letters above that point are missing.  This occurs if there is a highly
   conserved base and very few other bases.  The result is a huge gap where the
   highly conserved base should be.  Other printers do fine, so this is a
   problem with the Sun implementation of PostScript (will they ever get it
   right???).  If you don't have this window system, set the constant
   gooddisplay to true.  If you do want the logos to show up properly on the
   screen, use false.  Unfortunately, this will mean that the vertical
   translation for the small letters won't be done, so the display will be very
   slightly wrong.

*/
/* end module describe.makelogo */

/* begin module makelogo.const */

#define infofield       8
    /* size of field for printing information in bits */
#define infodecim       5
    /* number of decimal places for printing information */

#define nfield          4
    /* size of field for printing n, the number of sites */
#define mapmax          26
    /* the maximum number of symbols that can be sorted */

#define pwid            8
    /* width in character places to print PostScript numbers */
#define pdec            5   /* decimal places to print PostScript numbers */
#define pdecolor        4
/* decimal places for color descriptions (5 WILL CAUSE
                 NeWS 1.1 TO BOMB) */

#define pnum            100000L
    /* 10^pdec for testing when something will round to zero */

#define protecting      true
/* protect the user against PostScript requirements
   in user defined strings.  */

#define gooddisplay     false   /* see technical notes for explanation. */

/* end module makelogo.const */

/* begin module interact.const */

#define maxstring       1500   /* the maximum string */


/* end module interact.const version = 4.09; (@ of prgmod.p 1990 May 18 */


/* begin module interact.type */

typedef struct string {
  /* a string of characters */
  Char letters[maxstring];   /* the letters in the string */
  long length;   /* the number of characters in the string */
  long current;   /* the letter we are working on */
} string;

/* end module interact.type version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module makelogo.type */
/* types for sorting the symbols */
typedef char position;

typedef struct place {
  Char b;   /* the symbol */
  /* the number of symbols */
  long n;
} place;

/* type for making a list of strings */

typedef struct strings {
  string astring;
  double x;   /* x coordinate of the string */
  double y;   /* y coordinate of the string */
  double s;   /* scale factor */
  struct strings *next;
} strings;

/* end module makelogo.type */

/* begin module rsgra.type */
/* to link several wave definitions together */

typedef struct waveparam {
  /* parameters to define a cosine wave */
  /* define a cosine wave: */
  Char extreme;   /* h or l, the high or low extreme to be defined */
  double wavelocation;   /* the location in bases of the extreme */
  double wavebit;   /* the location in bits of the extreme */
  double waveamplitude;   /* the amplitude of the wave in bits */
  double wavelength;   /* the wave length of the wave in bases */
  double dash;   /* the size of dashes in cm.  dash <= 0 means no dashes */
  double thickness;   /* thickness of the wave in cm.  <= 0 means default */
  struct waveparam *next;   /* the next wave */
} waveparam;

/* end module rsgra.type */


/* begin module makelogo.var */
Static _TEXT symvec;   /* output of alpro program */
Static _TEXT makelogop;   /* parameters to control the program */
Static _TEXT colors;   /* color definitions */
Static _TEXT marks;   /* locations of marks on the logo */
Static _TEXT wave;   /* cosine wave definition */
Static _TEXT logo;   /* output of program */

/* the storage for sorting the symbols */
Static place map[mapmax];


Static jmp_buf _JL1;


/* end module makelogo.var */

/* begin module halt */
Static Void halt()
{
  /* stop the program.  the procedure performs a goto to the end of the
     program.  you must have a label:
        label 1;
     declared, and also the end of the program must have this label:
        1: end.
     examples are in the module libraries.
     this is the only goto in the delila system. */
  printf(" program halt.\n");
  longjmp(_JL1, 1);
}


/* end module halt version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module interact.clearstring */
Static Void clearstring(ribbon)
string *ribbon;
{
  /* empty the string */
  long index;   /* to the ribbon */

  for (index = 0; index < maxstring; index++)
    ribbon->letters[index] = ' ';
  ribbon->length = 0;
  ribbon->current = 0;
}  /* clearstring */


/* end module interact.clearstring version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module interact.getstring */
Static Void getstring(afile, buffer, gotten)
_TEXT *afile;
string *buffer;
boolean *gotten;
{
  /* get a string from a file not using string calls.  this lets one
obtain lines from a file without interactive prompts */
  long index;   /* of buffer */

  clearstring(buffer);
  if (BUFEOF(afile->f)) {
    *gotten = false;
    return;
  }
  index = 0;
  while (!P_eoln(afile->f) && index < maxstring) {
    index++;
    buffer->letters[index - 1] = getc(afile->f);
    if (buffer->letters[index - 1] == '\n')
      buffer->letters[index - 1] = ' ';
  }

  if (!P_eoln(afile->f)) {
    printf(" getstring: a line exceeds maximum string size (%ld)\n",
	   (long)maxstring);
    halt();
  }

  buffer->length = index;
  buffer->current = 1;
  fscanf(afile->f, "%*[^\n]");
  getc(afile->f);
  *gotten = true;
}  /* getstring */


/* end module interact.getstring version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module interact.writestring */
Static Void writestring(tofile, s)
_TEXT *tofile;
string *s;
{
  /* write the string s to file tofile, no writeln */
  long i;   /* index to s */
  long FORLIM;

  FORLIM = s->length;
  for (i = 0; i < FORLIM; i++)
    putc(s->letters[i], tofile->f);
}  /* writestring */


/* end module interact.writestring version = 4.09; (@ of prgmod.p 1990 May 18 */

Static boolean lessthan(a, b)
position a, b;
{
  /* see quicksort */
  /* the abs function makes sure upside down
     letters are still sorted the right way! */
  return (abs(map[a - 1].n) < abs(map[b - 1].n));
}


Static Void swap_(a, b)
position a, b;
{
  /* see quicksort */
  Char holdb;
  long holdn;

  holdn = map[a - 1].n;
  map[a - 1].n = map[b - 1].n;
  map[b - 1].n = holdn;

  holdb = map[a - 1].b;
  map[a - 1].b = map[b - 1].b;
  map[b - 1].b = holdb;

  /*;write(output,'a=',a:1,', b=',b:1); print (@ for testing */
}


/* begin module quicksort */

Static Void quicksort(left, right)
position left, right;
{
  /* quick sort a list between positions left and right, into ascending order.
     a position is simply a scalar of the form 0..max.
     the array to be sorted is dimensioned 1..max.
(the difference in the ranges is important to the correct operation
of the sort...)
     two external routines are used:
        function lessthan(a, b: position): boolean is a generalized test for
            value-at-a < value-at-b.
        procedure swap(a, b: position) switches the items at positions a and b.
     since these routines are external, the procedure is general.

     this procedure taken from the book
     'algorithms + data structures = programs' by niklaus wirth,
     prentice-hall, inc., englewood cliffs, n.j.(1976), pp. 76-82 */
  position lower, upper;   /* the positions looked at currently */
  position center;   /* the rough center of the region being sorted */

  lower = left;
  center = (left + right) / 2;
  upper = right;

  do {
    while (lessthan(lower, center))
      lower++;
    while (lessthan(center, upper))
      upper--;

    if (lower <= upper) {
      /* keep track of the center through the map: */
      if (lower == center)
	center = upper;
      else if (upper == center)
	center = lower;
      swap_(lower, upper);
      lower++;
      upper--;
    }
  } while (lower <= upper);

  if (left < upper)
    quicksort(left, upper);
  if (lower < right)
    quicksort(lower, right);
}


/* end module quicksort version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module copyaline */
Static Void copyaline(fin, fout)
_TEXT *fin, *fout;
{
  /* copy a line from file fin to file fout */
  while (!P_eoln(fin->f)) {
    putc(P_peek(fin->f), fout->f);
    getc(fin->f);
  }
  fscanf(fin->f, "%*[^\n]");
  getc(fin->f);
  putc('\n', fout->f);
}  /* copyaline */


/* end module copyaline version = 4.09; (@ of prgmod.p 1990 May 18 */

/* ********************************************************************** */
/* begin module rsgra.readwaveparameters */
Static Void readwaveparameters(afile, w)
_TEXT *afile;
waveparam **w;
{
  /* read from afile the wave parameters w */
  waveparam *p;   /* one of the definitions of a cosine wave */

  if (*afile->name != '\0') {
    if (afile->f != NULL)
      afile->f = freopen(afile->name, "r", afile->f);
    else
      afile->f = fopen(afile->name, "r");
  } else
    rewind(afile->f);
  if (afile->f == NULL)
    _EscIO(FileNotFound);
  RESETBUF(afile->f, Char);
  if (BUFEOF(afile->f)) {
    *w = NULL;
    return;
  }
  *w = (waveparam *)Malloc(sizeof(waveparam));
  p = *w;
  while (!BUFEOF(afile->f)) {
    fscanf(afile->f, "%c%*[^\n]", &p->extreme);
    getc(afile->f);
    if (p->extreme == '\n')
      p->extreme = ' ';
    fscanf(afile->f, "%lg%*[^\n]", &p->wavelocation);
    getc(afile->f);
    fscanf(afile->f, "%lg%*[^\n]", &p->wavebit);
    getc(afile->f);
    fscanf(afile->f, "%lg%*[^\n]", &p->waveamplitude);
    getc(afile->f);
    fscanf(afile->f, "%lg%*[^\n]", &p->wavelength);
    getc(afile->f);

    /* one may skip the dash and thickness parameters
       of the last wave definition.  This allows
       backwards compatability, but should not be
       used in general. */
    if (BUFEOF(afile->f)) {
      p->dash = 0.0;
      p->thickness = 0.0;
    } else {
      fscanf(afile->f, "%lg%*[^\n]", &p->dash);
      getc(afile->f);
      if (BUFEOF(afile->f))
	p->thickness = 0.0;
      else {
	fscanf(afile->f, "%lg%*[^\n]", &p->thickness);
	getc(afile->f);
      }
    }
    if (!BUFEOF(afile->f)) {
      p->next = (waveparam *)Malloc(sizeof(waveparam));
      p = p->next;
    } else
      p->next = NULL;
  }
}


/* end module rsgra.readwaveparameters */
/* ********************************************************************** */

/* begin module makelogo.protectpostscript */
Static Void protectpostscript(afile, c)
_TEXT *afile;
Char c;
{
  /* Special characters must be protected against!  Put out a protective
backslash for character c which would otherwise destroy the PostScript
interpreter.  The parenthesis is used in PostScript to indicate the bounds of a
string, while the percent is the comment character.  The backslash also needs
protection, since it is the escape to indicate that the next character is part
of the string. */
  if (c == '\\' || c == '%' || c == ')' || c == '(')
    putc('\\', afile->f);
}


/* end module makelogo.protectpostscript */

/* begin module makelogo.postscriptstring */
Static Void postscriptstring(tofile, s)
_TEXT *tofile;
string *s;
{
  /* write the string s to file tofile, no writeln.  Protect the user
by blocking postscript specific characters. */
  long i;   /* index to s */
  long FORLIM;

  putc('(', tofile->f);
  if (protecting) {
    FORLIM = s->length;
    for (i = 0; i < FORLIM; i++) {
      protectpostscript(tofile, s->letters[i]);
      putc(s->letters[i], tofile->f);
    }
  } else
    writestring(tofile, s);
  putc(')', tofile->f);
}  /* postscriptstring */


/* end module makelogo.postscriptstring */

/* ********************************************************************** */
/* ********************************************************************** */

/* begin module makelogo.truth */
Static Void truth(f, b)
_TEXT *f;
boolean b;
{
  /* write the true-false value of b to file f */
  if (b)
    fprintf(f->f, "true");
  else
    fprintf(f->f, "false");
}


/* Local variables for startpostscript: */
struct LOC_startpostscript {
  _TEXT *l, *colors;
  long lowest, highest, bar;
  double xcorner, ycorner, rotation, charwidth, barheight, barwidth, barbits,
	 Ibeamfraction;
  boolean barends, showingbox, outline, caps;
  long stacksperline, linesperpage;
  double linemove;
  boolean numbering, shrinking;
  double shrink;
  strings *thestrings;
  boolean HalfWhiteIbeam;
  Char symbol;   /* a symbol to which to assign a color */
  strings *stringspot;   /* current spot in thestrings */
  long stringnumber;   /* count of the strings written */
  double red, green, blue;   /* color definitions */
} ;

Local Void p1(LINK)
struct LOC_startpostscript *LINK;
{
  fprintf(LINK->l->f, "%%\n");
  fprintf(LINK->l->f, "%% logo from %ld to %ld\n",
	  LINK->lowest, LINK->highest);
  fprintf(LINK->l->f, "%%%%EndComments\n\n");

  fprintf(LINK->l->f,
	  "/cmfactor 72 2.54 div def %% defines points -> cm conversion\n");
  fprintf(LINK->l->f,
	  "/cm {cmfactor mul} bind def %% defines centimeters\n\n");

  fprintf(LINK->l->f, "%% user defined parameters\n");
  fprintf(LINK->l->f, "/lowest %ld def\n", LINK->lowest);
  fprintf(LINK->l->f, "/highest %ld def\n", LINK->highest);
  fprintf(LINK->l->f, "/bar %ld def\n", LINK->bar);
  fprintf(LINK->l->f, "/xcorner %*.*f cm def\n", pwid, pdec, LINK->xcorner);
  fprintf(LINK->l->f, "/ycorner %*.*f cm def\n", pwid, pdec, LINK->ycorner);
  fprintf(LINK->l->f, "/rotation %*.*f def %% degrees\n",
	  pwid, pdec, LINK->rotation);
  fprintf(LINK->l->f, "/charwidth %*.*f cm def\n",
	  pwid, pdec, LINK->charwidth);
  fprintf(LINK->l->f, "/barheight %*.*f cm def\n",
	  pwid, pdec, LINK->barheight);
  fprintf(LINK->l->f, "/barwidth %*.*f cm def\n", pwid, pdec, LINK->barwidth);
  fprintf(LINK->l->f, "/barbits %*.*f def %% bits\n",
	  pwid, pdec, LINK->barbits);
  fprintf(LINK->l->f, "/Ibeamfraction %*.*f def\n",
	  pwid, pdec, LINK->Ibeamfraction);
  fprintf(LINK->l->f, "/barends ");
  truth(LINK->l, LINK->barends);
  fprintf(LINK->l->f, " def\n");
  fprintf(LINK->l->f, "/showingbox ");
  truth(LINK->l, LINK->showingbox);
  fprintf(LINK->l->f, " def\n");
  fprintf(LINK->l->f, "/outline ");
  truth(LINK->l, LINK->outline);
  fprintf(LINK->l->f, " def\n");
  fprintf(LINK->l->f, "/caps ");
  truth(LINK->l, LINK->caps);
  fprintf(LINK->l->f, " def\n");
  fprintf(LINK->l->f, "/stacksperline %ld def\n", LINK->stacksperline);
  fprintf(LINK->l->f, "/linesperpage %ld def\n", LINK->linesperpage);
  fprintf(LINK->l->f, "/linemove %*.*f def\n", pwid, pdec, LINK->linemove);
  fprintf(LINK->l->f, "/numbering ");
  truth(LINK->l, LINK->numbering);
  fprintf(LINK->l->f, " def\n");
  fprintf(LINK->l->f, "/shrinking ");
  truth(LINK->l, LINK->shrinking);
  fprintf(LINK->l->f, " def\n");
  fprintf(LINK->l->f, "/shrink %*.*f def\n", pwid, pdec, LINK->shrink);
  fprintf(LINK->l->f, "/HalfWhiteIbeam ");
  truth(LINK->l, LINK->HalfWhiteIbeam);
  fprintf(LINK->l->f, " def\n\n");

  fprintf(LINK->l->f, "/knirhs 1 shrink sub 2 div def\n");
  fprintf(LINK->l->f, "/charwidth4 charwidth 4 div def\n");
  fprintf(LINK->l->f, "/charwidth2 charwidth 2 div def\n\n");

  if (LINK->outline) {
    fprintf(LINK->l->f,
      "%% Since outlining goes around the inner edge of the character\n");
    fprintf(LINK->l->f,
	    "%% make the thickness of the character bigger to compensate.\n");
    fprintf(LINK->l->f, "/setthelinewidth {2 setlinewidth} def\n");
  } else
    fprintf(LINK->l->f, "/setthelinewidth {1 setlinewidth} def\n");
  fprintf(LINK->l->f, "setthelinewidth %% set to normal linewidth\n\n");

  fprintf(LINK->l->f, "%% Set up the font size for the graphics\n");
  fprintf(LINK->l->f, "/fontsize charwidth def\n\n");

}

Local Void p2(LINK)
struct LOC_startpostscript *LINK;
{
  putc('%', LINK->l->f);
  fprintf(LINK->l->f,
	  "(*[[ This special comment allows deletion of the repeated\n");
  fprintf(LINK->l->f,
	  "%% procedures when several logos are concatenated together\n");
  fprintf(LINK->l->f, "%% See the censor program.\n\n");

  fprintf(LINK->l->f, "/charparams { %% char charparams => uy ux ly lx\n");
  fprintf(LINK->l->f,
	  "%% takes a single character and returns the coordinates that\n");
  fprintf(LINK->l->f, "%% defines the outer bounds of where the ink goes\n");
  fprintf(LINK->l->f, "  gsave\n");
  fprintf(LINK->l->f, "    newpath\n");
  fprintf(LINK->l->f, "    0 0 moveto\n");
  fprintf(LINK->l->f,
	  "    %% take the character off the stack and use it here:\n");
  fprintf(LINK->l->f, "    true charpath \n");
  fprintf(LINK->l->f, "    flattenpath \n");
  fprintf(LINK->l->f,
    "    pathbbox %% compute bounding box of 1 pt. char => lx ly ux uy\n");
  fprintf(LINK->l->f, "    %% the path is here, but toss it away ...\n");
  fprintf(LINK->l->f, "  grestore\n");
  fprintf(LINK->l->f, "  /uy exch def\n");
  fprintf(LINK->l->f, "  /ux exch def\n");
  fprintf(LINK->l->f, "  /ly exch def\n");
  fprintf(LINK->l->f, "  /lx exch def\n");
  /*
writeln(l,'%     % print the parameters to the user:');
writeln(l,'%     (lx) lx (ly) ly (ux) ux (uy) uy pstack');
writeln(l,'%     clear % clean up the stack, having printed all that');
*/
  fprintf(LINK->l->f, "} bind def\n\n");

  fprintf(LINK->l->f, "/dashbox { %% xsize ysize dashbox -\n");
  fprintf(LINK->l->f, "%% draw a dashed box of xsize by ysize (in points)\n");
  fprintf(LINK->l->f, "  /ysize exch def %% the y size of the box\n");
  fprintf(LINK->l->f, "  /xsize exch def %% the x size of the box\n");
  fprintf(LINK->l->f, "  1 setlinewidth\n");
  fprintf(LINK->l->f, "  gsave\n");
  fprintf(LINK->l->f,
	  "    %% Define the width of the dashed lines for boxes:\n");
  fprintf(LINK->l->f, "    newpath\n");
  fprintf(LINK->l->f, "    0 0 moveto\n");
  fprintf(LINK->l->f, "    xsize 0 lineto\n");
  fprintf(LINK->l->f, "    xsize ysize lineto\n");
  fprintf(LINK->l->f, "    0 ysize lineto\n");
  fprintf(LINK->l->f, "    0 0 lineto\n");
  fprintf(LINK->l->f, "    [3] 0 setdash\n");
  fprintf(LINK->l->f, "    stroke\n");
  fprintf(LINK->l->f, "  grestore\n");
  fprintf(LINK->l->f, "  setthelinewidth\n");
  fprintf(LINK->l->f, "} bind def\n\n");

  fprintf(LINK->l->f, "/boxshow { %% xsize ysize char boxshow\n");
  fprintf(LINK->l->f,
	  "%% show the character with a box around it, sizes in points\n");
  fprintf(LINK->l->f, "gsave\n");
  fprintf(LINK->l->f, "  /tc exch def %% define the character\n");
  fprintf(LINK->l->f, "  /ysize exch def %% the y size of the character\n");
  fprintf(LINK->l->f, "  /xsize exch def %% the x size of the character\n");
  fprintf(LINK->l->f, "  /xmulfactor 1 def /ymulfactor 1 def\n\n");

  fprintf(LINK->l->f,
	  "  %% if ysize is negative, make everything upside down!\n");
  fprintf(LINK->l->f, "  ysize 0 lt {\n");
  fprintf(LINK->l->f, "    %% put ysize normal in this orientation\n");
  fprintf(LINK->l->f, "    /ysize ysize abs def\n");
  fprintf(LINK->l->f, "    xsize ysize translate\n");
  fprintf(LINK->l->f, "    180 rotate\n");
  fprintf(LINK->l->f, "  } if\n\n");

  fprintf(LINK->l->f,
	  "  %% Don't show the box if it is a vertical bar, otherwise do.\n");
  fprintf(LINK->l->f,
	  "  showingbox {tc (|) ne {xsize ysize dashbox} if} if\n\n");

  fprintf(LINK->l->f, "  shrinking {tc (|) ne {\n");
  fprintf(LINK->l->f, "    xsize knirhs mul ysize knirhs mul translate\n");
  fprintf(LINK->l->f, "    shrink shrink scale\n");
  fprintf(LINK->l->f, "  } if} if\n\n");

  fprintf(LINK->l->f, "  2 {\n");
  fprintf(LINK->l->f, "    gsave\n");
  fprintf(LINK->l->f, "    xmulfactor ymulfactor scale\n");
  fprintf(LINK->l->f, "    tc charparams\n");
  fprintf(LINK->l->f, "    grestore\n\n");

  /* NOTE:  The following if statements in the next two sections make sure that
the size of the character has not gone to zero.  This apparently can happen
under OpenWindows, but not NeWS the Apple laserwriter or Freedom of the Press
Tektronix colorquick conversion. */

  fprintf(LINK->l->f, "    ysize %% desired size of character in points\n");
  fprintf(LINK->l->f, "    uy ly sub %% height of character in points\n");
  fprintf(LINK->l->f, "    dup 0.0 ne {\n");
  fprintf(LINK->l->f,
	  "      div %% factor by which to scale up the character\n");
  fprintf(LINK->l->f, "      /ymulfactor exch def\n");
  fprintf(LINK->l->f, "    } %% end if\n");
  fprintf(LINK->l->f, "    {pop pop}\n");
      /* remove the stuff from the stack and go on */
  fprintf(LINK->l->f, "    ifelse\n\n");
  fprintf(LINK->l->f, "    xsize %% desired size of character in points\n");
  fprintf(LINK->l->f, "    ux lx sub %% width of character in points\n");
  fprintf(LINK->l->f, "    dup 0.0 ne {\n");
  fprintf(LINK->l->f,
	  "      div %% factor by which to scale up the character\n");
  fprintf(LINK->l->f, "      /xmulfactor exch def\n");
  fprintf(LINK->l->f, "    } %% end if\n");
  fprintf(LINK->l->f, "    {pop pop}\n");
  fprintf(LINK->l->f, "    ifelse\n");
  fprintf(LINK->l->f, "  } repeat\n\n");

  /* The letter I must be specially centered in the Helvetica-Bold font.
We also account for the width of the character itself, so it should be centered
perfectly. */
  fprintf(LINK->l->f,
	  "  %% Adjust horizontal position if the symbol is an I\n");
  fprintf(LINK->l->f,
    "  tc (I) eq {charwidth 2 div %% half of requested character width\n");
  fprintf(LINK->l->f,
	  "             ux lx sub 2 div %% half of the actual character\n");
  fprintf(LINK->l->f, "                sub      0 translate} if\n");
  fprintf(LINK->l->f, "  %% Avoid x scaling for I\n");
  fprintf(LINK->l->f, "  tc (I) eq {/xmulfactor 1 def} if\n\n");

  fprintf(LINK->l->f, "  /xmove xmulfactor lx mul neg def\n");
  fprintf(LINK->l->f, "  /ymove ymulfactor ly mul neg def\n\n");

  fprintf(LINK->l->f, "  newpath\n");
  fprintf(LINK->l->f, "  xmove ymove moveto\n");
  fprintf(LINK->l->f, "  xmulfactor ymulfactor scale\n\n");

  if (LINK->outline) {
    fprintf(LINK->l->f, "  %% Outline characters:\n");
    /* get the character's path: */
    fprintf(LINK->l->f, "  tc true charpath\n");
    /* erase the center of the character (seems necessary to do!) */
    fprintf(LINK->l->f, "  gsave 1 setgray fill grestore\n");
    /* clip everything outside the character to prevent characters
       from overlapping each other (!) and then stroke the edge.
       Thus only the part of the stroke that reaches into the CENTER
       of the character becomes black and so the character size does
       not change even though it is an outline. */
    fprintf(LINK->l->f, "  clip stroke\n");
    printf("\nWARNING: Outlined characters will not display at all under NeWS\n");
    printf("but will print fine on an Apple LaserWriter IIntx\n\n");
  } else
    fprintf(LINK->l->f, "  tc show\n");

  fprintf(LINK->l->f, "grestore\n");
  fprintf(LINK->l->f, "} def\n\n");

  fprintf(LINK->l->f, "/numchar{ %% charheight character numchar\n");
  fprintf(LINK->l->f, "%% Make a character of given height in cm,\n");
  fprintf(LINK->l->f, "%% then move vertically by that amount\n");
  fprintf(LINK->l->f, "  gsave\n");
  fprintf(LINK->l->f, "    /char exch def\n");
  fprintf(LINK->l->f, "    /charheight exch cm def\n");

  /* set up the color statements */
  if (*LINK->colors->name != '\0') {
    if (LINK->colors->f != NULL)
      LINK->colors->f = freopen(LINK->colors->name, "r", LINK->colors->f);
    else
      LINK->colors->f = fopen(LINK->colors->name, "r");
  } else
    rewind(LINK->colors->f);
  if (LINK->colors->f == NULL)
    _EscIO(FileNotFound);
  RESETBUF(LINK->colors->f, Char);
  while (!BUFEOF(LINK->colors->f)) {
    if (P_peek(LINK->colors->f) == '*') {  /* skip comment lines */
      fscanf(LINK->colors->f, "%*[^\n]");
      getc(LINK->colors->f);
      continue;
    }
    /* implement the backslash protection scheme: */
    if (P_peek(LINK->colors->f) == '\\')
      getc(LINK->colors->f);
    fscanf(LINK->colors->f, "%c%lg%lg%lg%*[^\n]", &LINK->symbol, &LINK->red,
	   &LINK->green, &LINK->blue);
    getc(LINK->colors->f);
    if (LINK->symbol == '\n')
      LINK->symbol = ' ';
    fprintf(LINK->l->f, "    char (");
    protectpostscript(LINK->l, LINK->symbol);
    fprintf(LINK->l->f, "%c) eq {", LINK->symbol);
    if (LINK->red == 1.0 || LINK->red == 0.0)
      fprintf(LINK->l->f, "%ld", (long)floor(LINK->red + 0.5));
    else
      fprintf(LINK->l->f, "%*.*f", pwid, pdecolor, LINK->red);
    putc(' ', LINK->l->f);
    if (LINK->green == 1.0 || LINK->green == 0.0)
      fprintf(LINK->l->f, "%ld", (long)floor(LINK->green + 0.5));
    else
      fprintf(LINK->l->f, "%*.*f", pwid, pdecolor, LINK->green);
    putc(' ', LINK->l->f);
    if (LINK->blue == 1.0 || LINK->blue == 0.0)
      fprintf(LINK->l->f, "%ld", (long)floor(LINK->blue + 0.5));
    else
      fprintf(LINK->l->f, "%*.*f", pwid, pdecolor, LINK->blue);
    fprintf(LINK->l->f, " setrgbcolor} if\n");
  }

  /* note: adding the following text is sufficient to cause
the converter to C to bomb with a segmentation fault!
writeln(l,'    % note: charwidth and charheight');
writeln(l,'    %  have already been converted to points');
*/

  fprintf(LINK->l->f, "    charwidth charheight char boxshow\n");
  fprintf(LINK->l->f, "  grestore\n");

  /*
writeln(l,'  % the abs in the translation function below',
            ' handles negative heights');
  */

  /* The if statements ask if the character height is greater than
one point.  If it is, the display should be ok.  If not, some
displays mess up, notably OpenWindows (!).  Force the character
to be 1 point high just to be safe.  I hate bad implementations
of PostScript! */

  if (gooddisplay)
    fprintf(LINK->l->f, "  0 charheight abs translate\n");
  else
    fprintf(LINK->l->f,
	    "  charheight abs 1 gt {0 charheight abs translate} if\n");

  fprintf(LINK->l->f, "} bind def\n\n");   /* numchar */

}

Local Void p3(LINK)
struct LOC_startpostscript *LINK;
{
  fprintf(LINK->l->f, "/Ibar{\n");
  fprintf(LINK->l->f, "%% make a horizontal bar\n");
  fprintf(LINK->l->f, "gsave\n");
  fprintf(LINK->l->f, "  newpath\n");
  fprintf(LINK->l->f, "    charwidth4 neg 0 moveto\n");
  fprintf(LINK->l->f, "    charwidth4 0 lineto\n");
  fprintf(LINK->l->f, "  stroke\n");
  fprintf(LINK->l->f, "grestore\n");
  fprintf(LINK->l->f, "} bind def\n\n");   /* Ibar */

  fprintf(LINK->l->f, "/Ibeam{ %% height Ibeam\n");
  fprintf(LINK->l->f, "%% Make an Ibeam of twice the given height, in cm\n");
  fprintf(LINK->l->f, "  /height exch cm def\n");
  fprintf(LINK->l->f, "  /heightDRAW height Ibeamfraction mul def\n");
  fprintf(LINK->l->f, "  1 setlinewidth\n");
  fprintf(LINK->l->f, "     HalfWhiteIbeam outline not and\n");
  fprintf(LINK->l->f, "     {0.75 setgray} %% grey on bottom\n");
  fprintf(LINK->l->f, "     {0 setgray} %% black on bottom\n");
  fprintf(LINK->l->f, "  ifelse\n");
  fprintf(LINK->l->f, "  gsave\n");
  fprintf(LINK->l->f, "    charwidth2 height neg translate\n");
  fprintf(LINK->l->f, "    Ibar\n");
  fprintf(LINK->l->f, "    newpath\n");
  fprintf(LINK->l->f, "      0 0 moveto\n");
  fprintf(LINK->l->f, "      0 heightDRAW rlineto\n");
  fprintf(LINK->l->f, "    stroke\n");
  fprintf(LINK->l->f, "    0 setgray %% black on top\n");
  fprintf(LINK->l->f, "    newpath\n");
  fprintf(LINK->l->f, "      0 height moveto\n");
  fprintf(LINK->l->f, "      0 height rmoveto\n");
  fprintf(LINK->l->f, "      currentpoint translate\n");
  fprintf(LINK->l->f, "    Ibar\n");
  fprintf(LINK->l->f, "    newpath\n");
  fprintf(LINK->l->f, "      0 0 moveto\n");
  fprintf(LINK->l->f, "      0 heightDRAW neg rlineto\n");
  fprintf(LINK->l->f, "      currentpoint translate\n");
  fprintf(LINK->l->f, "    stroke\n");
  fprintf(LINK->l->f, "  grestore\n");
  fprintf(LINK->l->f, "  setthelinewidth\n");
  fprintf(LINK->l->f, "} bind def\n\n");   /* Ibeam */

  /* The original simple Ibeam
writeln(l,'/Ibeam{ % height Ibeam');
writeln(l,'% Make an Ibeam of twice the given height, in cm');
writeln(l,'  /height exch cm def');
writeln(l,'  1 setlinewidth');
writeln(l,'  0 setgray % black');
writeln(l,'  gsave');
writeln(l,'    charwidth2 height neg translate');
writeln(l,'    Ibar');
writeln(l,'    newpath');
writeln(l,'      0 0 moveto');
writeln(l,'      0 height 2 mul lineto');
writeln(l,'      currentpoint translate');
writeln(l,'    stroke');
writeln(l,'    Ibar');
writeln(l,'  grestore');
writeln(l,'  setthelinewidth');
writeln(l,'} bind def'); (# Ibeam #)
writeln(l);
*/

  fprintf(LINK->l->f, "/makenumber { %% number makenumber\n");
  fprintf(LINK->l->f, "%% make the number\n");
  fprintf(LINK->l->f, "gsave\n");
  fprintf(LINK->l->f, "  shift %% shift to the other side of the stack\n");
  fprintf(LINK->l->f, "  90 rotate %% rotate so the number fits\n");
  fprintf(LINK->l->f,
	  "  dup stringwidth pop %% find the length of the number\n");
  fprintf(LINK->l->f, "  neg %% prepare for move\n");
  fprintf(LINK->l->f,
	  "  charwidth (0) charparams uy ly sub %% height of numbers\n");
  fprintf(LINK->l->f, "  sub 2 div %%\n");
  fprintf(LINK->l->f, "  moveto %% move back to provide space\n");
  fprintf(LINK->l->f, "  show\n");
  fprintf(LINK->l->f, "grestore\n");
  fprintf(LINK->l->f, "} bind def\n\n");   /* makenumber */

  fprintf(LINK->l->f, "/shift{ %% move to the next horizontal position\n");
  fprintf(LINK->l->f, "charwidth 0 translate\n");
  fprintf(LINK->l->f, "} bind def\n\n");

  fprintf(LINK->l->f, "/makebar { %% make a vertical bar and shift\n");
  fprintf(LINK->l->f, "   barwidth barheight (|) boxshow\n");
  fprintf(LINK->l->f, "   barwidth 0 translate\n");
  fprintf(LINK->l->f, "} def\n\n");

  fprintf(LINK->l->f, "%% definitions for maketic\n");
  fprintf(LINK->l->f, "/str 10 string def %% string to hold number\n");
  fprintf(LINK->l->f, "%% points of movement between tic marks:\n");
  fprintf(LINK->l->f, "%% (abs protects against barbits being negative)\n");
  fprintf(LINK->l->f, "/ticmovement barheight barbits abs div def\n\n");
  fprintf(LINK->l->f, "/maketic { %% make tic marks and numbers\n");
  fprintf(LINK->l->f, "gsave\n");
  fprintf(LINK->l->f, "  %% initial increment limit proc for\n");
  fprintf(LINK->l->f, "  0 1 barbits abs cvi\n");
  fprintf(LINK->l->f, "  {/loopnumber exch def\n\n");
  fprintf(LINK->l->f,
	  "    %% convert the number coming from the loop to a string\n");
  fprintf(LINK->l->f, "    %% and find its width\n");
  fprintf(LINK->l->f, "    loopnumber 10 str cvrs\n");
  fprintf(LINK->l->f,
	  "    /stringnumber exch def %% string representing the number\n\n");
  fprintf(LINK->l->f, "    stringnumber stringwidth pop\n");
  fprintf(LINK->l->f,
	  "    /numberwidth exch def %% width of number to show\n\n");
  fprintf(LINK->l->f, "    /halfnumberheight\n");
  fprintf(LINK->l->f, "      stringnumber charparams %% capture sizes\n");
  fprintf(LINK->l->f, "      uy ly sub 2 div\n");
  fprintf(LINK->l->f, "    def\n\n");
  fprintf(LINK->l->f, "    numberwidth 2 mul %% move back two digits\n");
  fprintf(LINK->l->f,
	  "    neg loopnumber ticmovement mul %% shift on y axis\n");
  fprintf(LINK->l->f, "    halfnumberheight sub %% down half the digit\n\n");
  fprintf(LINK->l->f, "    moveto %% move back the width of the string\n\n");
  fprintf(LINK->l->f, "    stringnumber show\n\n");
  fprintf(LINK->l->f, "    %% now show the tic mark\n");
  fprintf(LINK->l->f, "    0 halfnumberheight rmoveto %% shift up again\n");
  fprintf(LINK->l->f, "    numberwidth 0 rlineto\n");
  fprintf(LINK->l->f, "    stroke\n");
  /* note: the following two lines are separated to avoid a
problem with the p2c Pascal to C translator */
  fprintf(LINK->l->f, "  }");
  fprintf(LINK->l->f, " for\n");
  fprintf(LINK->l->f, "  grestore\n");

  /*
writeln(l,'% at this point numberwidth says how far back to go.  do that');
*/
  /* put the word 'bits' on the left */
  fprintf(LINK->l->f, "  gsave\n");
  fprintf(LINK->l->f, "    /labelstring (bits) def\n");
  fprintf(LINK->l->f, "    numberwidth neg 2.5 mul\n");
      /* x coordinate to start writing */
  fprintf(LINK->l->f, "    barheight\n");   /* height of bar */
  fprintf(LINK->l->f, "    labelstring stringwidth pop\n");
      /* length of string */
  fprintf(LINK->l->f, "    sub 2 div\n");
      /* y coordinate to start writing */
  fprintf(LINK->l->f, "    translate\n");
  fprintf(LINK->l->f, "    90 rotate\n");
  fprintf(LINK->l->f, "    0 0 moveto\n");
  fprintf(LINK->l->f, "    labelstring show\n");
      /* x coordinate to start writing */
  fprintf(LINK->l->f, "  grestore\n");

  fprintf(LINK->l->f, "} def\n");

}

Local Void p4(LINK)
struct LOC_startpostscript *LINK;
{
  fprintf(LINK->l->f, "\n/degpercycle 360 def\n");
  fprintf(LINK->l->f, " \n");
  fprintf(LINK->l->f, "/cosine {%%    amplitude  phase  wavelength  base\n");
  fprintf(LINK->l->f,
	  "%%             xmin ymin xmax ymax step dash thickness\n");
  fprintf(LINK->l->f, "%%             cosine -\n");
  fprintf(LINK->l->f, "%% draws a cosine wave with the given parameters:\n");
  fprintf(LINK->l->f, "%% amplitude (points): height of the wave\n");
  fprintf(LINK->l->f, "%% phase (points): starting point of the wave\n");
  fprintf(LINK->l->f, "%% wavelength (points): length from crest to crest\n");
  fprintf(LINK->l->f, "%% base (points): lowest point of the curve\n");
  fprintf(LINK->l->f,
	  "%% xmin ymin xmax ymax (points): region in which to draw\n");
  fprintf(LINK->l->f, "%% step steps for drawing a cosine wave\n");
  fprintf(LINK->l->f,
    "%% dash if greater than zero, size of dashes of the wave (points)\n");
  fprintf(LINK->l->f,
	  "%% thickness if greater than zero, thickness of wave (points)\n\n");
  fprintf(LINK->l->f, "  /thickness exch def\n");
  fprintf(LINK->l->f, "  /dash exch def\n");
  fprintf(LINK->l->f, "  /step exch def\n");
  fprintf(LINK->l->f, "  /ymax exch def\n");
  fprintf(LINK->l->f, "  /xmax exch def\n");
  fprintf(LINK->l->f, "  /ymin exch def\n");
  fprintf(LINK->l->f, "  /xmin exch def\n");
  fprintf(LINK->l->f, "  /base exch def\n");
  fprintf(LINK->l->f, "  /wavelength exch def\n");
  fprintf(LINK->l->f, "  /phase exch def\n");
  fprintf(LINK->l->f, "  /amplitude exch def\n");
  fprintf(LINK->l->f,
	  "  %% fun := amplitude*cos( ((-y-phase)/wavelength)*360) + base\n");
  fprintf(LINK->l->f,
	  "  /fun {phase sub wavelength div degpercycle mul cos\n");
  fprintf(LINK->l->f, "           amplitude mul base add} def\n\n");
  fprintf(LINK->l->f, "  gsave\n");
  fprintf(LINK->l->f, "    /originallinewidth currentlinewidth def\n");
  fprintf(LINK->l->f, "    thickness 0 gt {thickness setlinewidth} if\n");
  fprintf(LINK->l->f, "    /c currentlinewidth def\n");
  fprintf(LINK->l->f, "%%   Make the curve fit into the region specified\n");
  fprintf(LINK->l->f, "    newpath\n");
  fprintf(LINK->l->f, "    xmin ymin c sub moveto\n");
  fprintf(LINK->l->f, "    xmax ymin c sub lineto\n");
  fprintf(LINK->l->f, "    xmax ymax c add lineto\n");
  fprintf(LINK->l->f, "    xmin ymax c add lineto\n");
  fprintf(LINK->l->f, "    closepath\n");
  fprintf(LINK->l->f, "    clip\n\n");   /* stroke'); */
  fprintf(LINK->l->f, "    newpath\n");
  fprintf(LINK->l->f, "    xmin dup fun moveto\n");
  fprintf(LINK->l->f,
	  "    xmin step xmax { %% loop from xmin by step to xmax\n");
  fprintf(LINK->l->f, "      dup fun lineto } for\n");
  fprintf(LINK->l->f,
	  "    dash 0 gt {[dash cvi] 0 setdash} if %% turn dash on\n");
  fprintf(LINK->l->f, "    stroke\n\n");
  fprintf(LINK->l->f, "    originallinewidth setlinewidth\n");
  fprintf(LINK->l->f, "  grestore\n");
  fprintf(LINK->l->f, "} bind def\n\n");

  /* example test:
% amplitude  phase  wavelength  base:
   -2.50000 cm  6.40000 cm  8.48000 cm  7.50000 cm
% xmin ymin xmax ymax step:
   -4.80000 cm  0.00000 cm 17.60000 cm 50.50000 cm 1
    0.5 cm 0.1 cosine
  */

  fprintf(LINK->l->f, "/circle { %% x y radius circle - (path)\n");
  fprintf(LINK->l->f, "newpath 0 360 arc closepath} bind def\n\n");

  fprintf(LINK->l->f,
    "%% The following special comment allows deletion of the repeated\n");
  fprintf(LINK->l->f,
	  "%% procedures when several logos are concatenated together\n");
  fprintf(LINK->l->f, "%% See the censor program.\n");
  fprintf(LINK->l->f, "%%]]%%*)\n\n");

  fprintf(LINK->l->f, "/startpage { %% start a page\n");
  fprintf(LINK->l->f, "  %% set the font used in the title strings\n");
  fprintf(LINK->l->f, "  /Times-Bold findfont fontsize scalefont setfont\n");
  fprintf(LINK->l->f, "  gsave\n");
  fprintf(LINK->l->f,
	  "  erasepage %% REMOVE FOR PACKAGING INTO ANOTHER FIGURE\n");
  fprintf(LINK->l->f, "  xcorner ycorner translate\n");
  fprintf(LINK->l->f, "  rotation rotate\n");

}

Local Void p5(LINK)
struct LOC_startpostscript *LINK;
{
  _TEXT TEMP;

  if (LINK->thestrings == NULL)
    return;

  fprintf(LINK->l->f, "  %% create the user defined strings\n");
  LINK->stringspot = LINK->thestrings;
  LINK->stringnumber = 0;
  while (LINK->stringspot != NULL) {
    fprintf(LINK->l->f, "  gsave\n");
    if (LINK->stringspot->x < 0) {
      LINK->stringnumber++;
      fprintf(LINK->l->f, "    %% string number %ld\n", LINK->stringnumber);
      fprintf(LINK->l->f, "    %% center the string\n");
      fprintf(LINK->l->f, "    /stringscale %*.*f def\n",
	      pwid, pdec, LINK->stringspot->s);
      fprintf(LINK->l->f, "    ");
      postscriptstring(LINK->l, &LINK->stringspot->astring);
      fprintf(LINK->l->f,
	      "\n    stringwidth pop stringscale mul neg stacksperline\n");
      /* the string is actually going to be bigger than this, so multiply
         it up by the stringscalefactor */

      /* check if the user will be fooled by the loss of the string */
      if (LINK->stacksperline > (LINK->highest - LINK->lowest) * 2) {
	printf("\nWARNING: if you don't see centered string number %ld:\n",
	       LINK->stringnumber);
	printf("    \"");
	TEMP.f = stdout;
	*TEMP.name = '\0';
	writestring(&TEMP, &LINK->stringspot->astring);
	printf("\"\n");
	printf(
	  "it may be off the page because stacksperline is large (%ld) relative to the\n",
	  LINK->stacksperline);
	printf(
	  "FROM-TO range (%ld to %ld) and centering is based on stacks-per-line.  To\n",
	  LINK->lowest, LINK->highest);
	printf("solve this, reduce parameter stacksperline to FROM-TO+1 = %ld\n\n",
	       LINK->highest - LINK->lowest + 1);
      }

      fprintf(LINK->l->f, "    charwidth mul add 2 div\n");
      fprintf(LINK->l->f, "    %*.*f cm moveto\n",
	      pwid, pdec, LINK->stringspot->y);
    } else {
      fprintf(LINK->l->f, "    /stringscale %*.*f def\n",
	      pwid, pdec, LINK->stringspot->s);
      fprintf(LINK->l->f, "    %*.*f cm %*.*f cm moveto\n",
	      pwid, pdec, LINK->stringspot->x, pwid, pdec,
	      LINK->stringspot->y);
    }
    fprintf(LINK->l->f, "    stringscale stringscale scale\n");
    fprintf(LINK->l->f, "    ");
    postscriptstring(LINK->l, &LINK->stringspot->astring);
    fprintf(LINK->l->f, " show\n");
    fprintf(LINK->l->f, "    %%\n");
    LINK->stringspot = LINK->stringspot->next;
    fprintf(LINK->l->f, "  grestore\n");
  }
}

Local Void p6(LINK)
struct LOC_startpostscript *LINK;
{
  /* no obnoxious messages for now:
(* create obnoxious message to keep the user straight and true... *)
if sitesused then begin
writeln(l,
'gsave /stringscale  0.80000 def 0.00000 cm -2.00000 cm moveto % OBNOXIOUS');
writeln(l, 'stringscale stringscale scale % OBNOXIOUS');
writeln(l,
            '(\(Note: error bars show an UNDERESTIMATE of the true variation\))',
            ' % OBNOXIOUS');
writeln(l, 'show grestore % OBNOXIOUS');
end;
  */

  fprintf(LINK->l->f, "  %% now move up to the top of the top line:\n");
  fprintf(LINK->l->f,
	  "  0 linesperpage linemove barheight mul mul translate\n\n");
  fprintf(LINK->l->f, "  %% set the font used in the logos\n");
  fprintf(LINK->l->f,
	  "  /Helvetica-Bold findfont fontsize scalefont setfont\n");
  fprintf(LINK->l->f, "} def\n\n");

  fprintf(LINK->l->f,
	  "%%(*[[ This special comment allows deletion of the repeated\n");
  fprintf(LINK->l->f,
	  "%% procedures when several logos are concatenated together\n");
  fprintf(LINK->l->f, "%% See the censor program.\n\n");

  fprintf(LINK->l->f, "/endpage { %% end a page\n");
  fprintf(LINK->l->f, "  grestore\n");
  fprintf(LINK->l->f,
	  "  showpage %% REMOVE FOR PACKAGING INTO ANOTHER FIGURE\n");
  fprintf(LINK->l->f, "} def\n\n");

  fprintf(LINK->l->f, "/startline{ %% start a line\n");
  fprintf(LINK->l->f, "%% move down to the bottom of the line:\n");
  fprintf(LINK->l->f, "  0 linemove barheight mul neg translate\n");
  fprintf(LINK->l->f, "  gsave\n");
  if (LINK->barends) {
    fprintf(LINK->l->f, "  maketic\n");
    fprintf(LINK->l->f, "  makebar\n");
  }
  fprintf(LINK->l->f, "} def\n\n");

  fprintf(LINK->l->f, "/endline{ %% end a line\n");
/*>>>>>>>>   Never print the right-hand bar
  if (LINK->barends)
    fprintf(LINK->l->f, "  makebar\n");
*/
  fprintf(LINK->l->f, "  grestore\n");
  fprintf(LINK->l->f, "} def\n\n");
  fprintf(LINK->l->f,
    "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n");
  fprintf(LINK->l->f,
    "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% End of procedures %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n");
  fprintf(LINK->l->f,
    "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n\n");

  fprintf(LINK->l->f,
    "%% The following special comment allows deletion of the repeated\n");
  fprintf(LINK->l->f,
	  "%% procedures when several logos are concatenated together\n");
  fprintf(LINK->l->f, "%% See the censor program.\n");
  fprintf(LINK->l->f, "%%]]%%*)\n\n");

}


/* end module makelogo.truth */

/* begin module makelogo.startpostscript */
Static Void startpostscript(l_, colors_, lowest_, highest_, bar_, xcorner_,
  ycorner_, rotation_, charwidth_, barheight_, barwidth_, barbits_,
  Ibeamfraction_, barends_, showingbox_, outline_, caps_, stacksperline_,
  linesperpage_, linemove_, numbering_, shrinking_, shrink_, thestrings_,
  HalfWhiteIbeam_)
_TEXT *l_, *colors_;
long lowest_, highest_, bar_;
double xcorner_, ycorner_, rotation_, charwidth_, barheight_, barwidth_,
       barbits_, Ibeamfraction_;
boolean barends_, showingbox_, outline_, caps_;
long stacksperline_, linesperpage_;
double linemove_;
boolean numbering_, shrinking_;
double shrink_;
strings *thestrings_;
boolean HalfWhiteIbeam_;
{
  /* not in use now:
                            sitesused: boolean);
  */
  /* start the PostScript definitions to file l.
This routine is broken up into a number of separate procedures
to allow translation into C by the p2c program.  If this is not
done, then apparently p2c's memory for literal strings fills up,
and one gets errors like 'segmentation fault'. */
  struct LOC_startpostscript V;

  V.l = l_;
  V.colors = colors_;
  V.lowest = lowest_;
  V.highest = highest_;
  V.bar = bar_;
  V.xcorner = xcorner_;
  V.ycorner = ycorner_;
  V.rotation = rotation_;
  V.charwidth = charwidth_;
  V.barheight = barheight_;
  V.barwidth = barwidth_;
  V.barbits = barbits_;
  V.Ibeamfraction = Ibeamfraction_;
  V.barends = barends_;
  V.showingbox = showingbox_;
  V.outline = outline_;
  V.caps = caps_;
  V.stacksperline = stacksperline_;
  V.linesperpage = linesperpage_;
  V.linemove = linemove_;
  V.numbering = numbering_;
  V.shrinking = shrinking_;
  V.shrink = shrink_;
  V.thestrings = thestrings_;
  V.HalfWhiteIbeam = HalfWhiteIbeam_;
  p1(&V);
  p2(&V);
  p3(&V);
  p4(&V);
  p5(&V);
  p6(&V);
}


/* end module makelogo.startpostscript */

/* ********************************************************************** */
/* ********************************************************************** */

/* begin module capitalize */
Static Char capitalize(c)
Char c;
{
  /* convert the character c to upper case */
  long n;   /* c is the n'th letter of the alphabet */

  n = c;

  if (n >= 'a' && n <= 'z')
    c = _toupper(n);

  return c;
}


/* end module capitalize version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module skipblanks */
Static Void skipblanks(thefile)
_TEXT *thefile;
{
  /* skip over blanks until a non-blank, or end of line, is found */
  while ((P_peek(thefile->f) == ' ') & (!P_eoln(thefile->f)))
    getc(thefile->f);
}


Static Void skipnonblanks(thefile)
_TEXT *thefile;
{
  /* skip over nonblanks until a blank, or end of line, is found */
  while ((P_peek(thefile->f) != ' ') & (!P_eoln(thefile->f)))
    getc(thefile->f);
}


/* end module skipblanks version = 2.63; (@ of dops.p 1991 November 2 */

/* begin module softnumbertest */
Static boolean softnumbertest(f)
_TEXT *f;
{
  /* test that a number follows, but don't die if there is none */
  skipblanks(f);
  if (P_peek(f->f) != '9' && P_peek(f->f) != '8' && P_peek(f->f) != '7' &&
      P_peek(f->f) != '6' && P_peek(f->f) != '5' && P_peek(f->f) != '4' &&
      P_peek(f->f) != '3' && P_peek(f->f) != '2' && P_peek(f->f) != '1' &&
      P_peek(f->f) != '0' && P_peek(f->f) != '+' && P_peek(f->f) != '-') {
    /* we can't do this because it would wreck reading parameters
          bar(output,'-');
          writeln(output,'NOTE: in the parameter file,',
            ' another number is now allowed for on this line:');
          copyaline(f,output);
    */
    return false;
  } else
    return true;
}


/* end module softnumbertest */

/* begin module makelogo.readparameters */
Static Void readparameters(theplace, lowest, highest, bar, xcorner, ycorner,
			   rotation, charwidth, barheight, barwidth, barbits,
			   Ibeamfraction, barends, showingbox, outline, caps,
			   stacksperline, linesperpage, linemove, numbering,
			   shrinking, shrink, thestrings)
_TEXT *theplace;
long *lowest, *highest, *bar;
double *xcorner, *ycorner, *rotation, *charwidth, *barheight, *barwidth,
       *barbits, *Ibeamfraction;
boolean *barends, *showingbox, *outline, *caps;
long *stacksperline, *linesperpage;
double *linemove;
boolean *numbering, *shrinking;
double *shrink;
strings **thestrings;
{
  /* read in the parameters from the place */
  boolean gotten;   /* if true, we got a user defined string */
  long numberstrings;   /* the number of strings to read from theplace */
  long n;   /* index to numberstrings */
  strings *stringspot;   /* current spot in thestrings */

  if (*theplace->name != '\0') {
    if (theplace->f != NULL)
      theplace->f = freopen(theplace->name, "r", theplace->f);
    else
      theplace->f = fopen(theplace->name, "r");
  } else
    rewind(theplace->f);
  if (theplace->f == NULL)
    _EscIO(FileNotFound);
  RESETBUF(theplace->f, Char);
  if (!BUFEOF(theplace->f)) {
    fscanf(theplace->f, "%ld%ld%*[^\n]", lowest, highest);
    getc(theplace->f);
  } else {
    printf("missing all parameters\n");
    halt();
  }

  if (!BUFEOF(theplace->f)) {
    fscanf(theplace->f, "%ld%*[^\n]", bar);
    getc(theplace->f);
  } else {
    printf("missing bar coordinate parameter\n");
    halt();
  }

  if (!BUFEOF(theplace->f)) {
    fscanf(theplace->f, "%lg%lg%*[^\n]", xcorner, ycorner);
    getc(theplace->f);
  } else {
    printf("missing corner coordinate parameters\n");
    halt();
  }

  if (!BUFEOF(theplace->f)) {
    fscanf(theplace->f, "%lg%*[^\n]", rotation);
    getc(theplace->f);
  } else {
    printf("missing rotation parameter\n");
    halt();
  }
  if ((long)floor(*rotation + 0.5) % 90 != 0) {
    printf("\nWARNING: rotations that are not multiples of\n");
    printf("of 90 degrees are likely to be scaled\n");
    printf("incorrectly, due to a PostScript limitation.\n");
    printf("See the description of the pathbbox function\n");
    printf("in the Red book.\n\n");
  }
/* p2c: makelogo.p, line 1569:
 * Note: Using % for possibly-negative arguments [317] */

  if (!BUFEOF(theplace->f)) {
    fscanf(theplace->f, "%lg%*[^\n]", charwidth);
    getc(theplace->f);
  } else {
    printf("missing charwidth parameter\n");
    halt();
  }
  if (*charwidth <= 0.0) {
    printf("charwidth parameter must be > 0 cm\n");
    halt();
  }

  if (!BUFEOF(theplace->f)) {
    fscanf(theplace->f, "%lg%lg%*[^\n]", barheight, barwidth);
    getc(theplace->f);
  } else {
    printf("missing barheight and barwidth parameters\n");
    halt();
  }
  if (*barheight <= 0.0) {
    printf("barheight parameter must be > 0 cm\n");
    halt();
  }
  if (*barwidth <= 0.0) {
    printf("barwidth parameter must be > 0 cm\n");
    halt();
  }

  if (!BUFEOF(theplace->f)) {
    fscanf(theplace->f, "%lg%*[^\n]", barbits);
    getc(theplace->f);
  } else {
    printf("missing barbits parameter\n");
    halt();
  }
  if (*barbits < 0.0) {
    printf(
      "\nWARNING: are you SURE you don't want to show the variation due to a small\n");
    printf("number of samples (i.e. the I-beam error bars)?\n\n");
  } else {
    printf("Reminder: the I-beam error bars show the\n");
    printf("variation of the entire stack not just the highest\n");
    printf("symbol, even though it may look like that.\n");
  }
  if (*barbits == 0.0) {
    printf("barbits parameter must not be zero\n");
    halt();
  }

  /* slip in a new parameter, but do it softly.  That is,
     if the user has a number, the parameter is there and read,
     but if it is not a number, just go on to the next */
  if (softnumbertest(theplace)) {
    fscanf(theplace->f, "%lg%*[^\n]", Ibeamfraction);
    getc(theplace->f);
    /* Although we could do checks on this, it's fun, and perhaps
       useful to allow the user to put in weird numbers here.  */
  } else
    *Ibeamfraction = 1.0;

  if (!BUFEOF(theplace->f)) {
    if (P_peek(theplace->f) == 'b')
      *barends = true;
    else
      *barends = false;
    fscanf(theplace->f, "%*[^\n]");
    getc(theplace->f);
  } else {
    printf("barends parameter is missing\n");
    halt();
  }

  if (!BUFEOF(theplace->f)) {
    if (P_peek(theplace->f) == 's')
      *showingbox = true;
    else
      *showingbox = false;
    fscanf(theplace->f, "%*[^\n]");
    getc(theplace->f);
  } else {
    printf("showingbox parameter is missing\n");
    halt();
  }

  if (!BUFEOF(theplace->f)) {
    if (P_peek(theplace->f) == 'o')
      *outline = true;
    else
      *outline = false;
    fscanf(theplace->f, "%*[^\n]");
    getc(theplace->f);
  } else {
    printf("outline parameter is missing\n");
    halt();
  }

  if (!BUFEOF(theplace->f)) {
    if (P_peek(theplace->f) == 'c')
      *caps = true;
    else
      *caps = false;
    fscanf(theplace->f, "%*[^\n]");
    getc(theplace->f);
  } else {
    printf("caps parameter is missing\n");
    halt();
  }

  if (!BUFEOF(theplace->f)) {
    fscanf(theplace->f, "%ld%*[^\n]", stacksperline);
    getc(theplace->f);
  } else {
    printf("stacksperline parameter is missing\n");
    halt();
  }
  if (*stacksperline <= 0) {
    printf("stacksperline parameter must be positive\n");
    halt();
  }

  if (!BUFEOF(theplace->f)) {
    fscanf(theplace->f, "%ld%*[^\n]", linesperpage);
    getc(theplace->f);
  } else {
    printf("linesperpage parameter is missing\n");
    halt();
  }
  if (*linesperpage <= 0) {
    printf("linesperpage parameter must be positive\n");
    halt();
  }

  if (!BUFEOF(theplace->f)) {
    fscanf(theplace->f, "%lg%*[^\n]", linemove);
    getc(theplace->f);
  } else {
    printf("linemove parameter is missing\n");
    halt();
  }
  if (*linemove <= 0) {
    printf("linemove parameter must be positive\n");
    halt();
  }

  if (!BUFEOF(theplace->f)) {
    if (P_peek(theplace->f) == 'n')
      *numbering = true;
    else
      *numbering = false;
    fscanf(theplace->f, "%*[^\n]");
    getc(theplace->f);
  } else {
    printf("numbering parameters are missing\n");
    halt();
  }

  if (!BUFEOF(theplace->f)) {
    fscanf(theplace->f, "%lg%*[^\n]", shrink);
    getc(theplace->f);
  } else {
    printf("shrink parameter is missing\n");
    halt();
  }
  if (*shrink > 1.0) {
    printf("Shrink parameter must be less than or equal to 1.\n");
    printf("This way, you won't create a misleading logo\n");
    printf("which has an apparent height larger than it should.\n");
  }
  if (*shrink > 0.0 && *shrink < 1.0 && !*showingbox) {
    printf("Shrinking can only be done when showing the dashed box.\n");
    printf("This way, you won't create a misleading logo\n");
    printf("which has an apparent height smaller than it should.\n");
  }
  if (!*showingbox || *shrink <= 0.0 || *shrink >= 1.0)
    *shrinking = false;
  else
    *shrinking = true;

  if (!BUFEOF(theplace->f)) {
    fscanf(theplace->f, "%ld%*[^\n]", &numberstrings);
    getc(theplace->f);
  } else {
    printf("number of user defined strings must be given\n");
    halt();
  }
  if (numberstrings <= 0) {
    *thestrings = NULL;
    return;
  }

  *thestrings = (strings *)Malloc(sizeof(strings));
  stringspot = *thestrings;
  for (n = 1; n <= numberstrings; n++) {
    if (BUFEOF(theplace->f)) {
      printf("missing a user defined string coordinate\n");
      halt();
    }
    fscanf(theplace->f, "%lg%lg%lg%*[^\n]", &stringspot->x, &stringspot->y,
	   &stringspot->s);
    getc(theplace->f);
    getstring(theplace, &stringspot->astring, &gotten);
    if (!gotten) {
      printf("missing a user defined string\n");
      halt();
    }
    if (n < numberstrings) {
      stringspot->next = (strings *)Malloc(sizeof(strings));
      stringspot = stringspot->next;
    } else
      stringspot->next = NULL;
  }
}


/* end module makelogo.readparameters */

/* begin module makelogo.warnifsitesused */
Static Void warnifsitesused(symvec, fout, sitesused)
_TEXT *symvec, *fout;
boolean *sitesused;
{
  /* 'warn [the user about error bars] if [the] sites [program] was used
[to create the symvec].' */
  Char a, b, c, d, e, f, g;   /* a simple way to do a string */

  *sitesused = false;
  if (*symvec->name != '\0') {
    if (symvec->f != NULL)
      symvec->f = freopen(symvec->name, "r", symvec->f);
    else
      symvec->f = fopen(symvec->name, "r");
  } else
    rewind(symvec->f);
  if (symvec->f == NULL)
    _EscIO(FileNotFound);
  RESETBUF(symvec->f, Char);
  if (BUFEOF(symvec->f))
    return;
  fscanf(symvec->f, "%*[^\n]");
  getc(symvec->f);   /* skip first line ('* dalvec') */
  if (BUFEOF(symvec->f))  /* determine prior program name */
    return;
  /* check that the string '* sites' exists */
  /* *   s i t e s */
  a = getc(symvec->f);
  b = getc(symvec->f);
  c = getc(symvec->f);
  d = getc(symvec->f);
  e = getc(symvec->f);
  f = getc(symvec->f);
  g = getc(symvec->f);
  if (a == '\n')
    a = ' ';
  if (b == '\n')
    b = ' ';
  if (c == '\n')
    c = ' ';
  if (d == '\n')
    d = ' ';
  if (e == '\n')
    e = ' ';
  if (f == '\n')
    f = ' ';
  if (g == '\n')
    g = ' ';
  if (a != '*' || b != ' ' || c != 's' || d != 'i' || e != 't' || f != 'e' ||
      g != 's')
    return;
  fprintf(fout->f,
    "******************************************************************************\n");
  fprintf(fout->f,
    "* NOTE: since the data come from the sites program, the error bar is not     *\n");
  fprintf(fout->f,
    "* printed on the sequence logo.                                              *\n");
  fprintf(fout->f,
    "******************************************************************************\n");

  /* no more obnoxious messages:
              writeln(fout);
              writeln(fout,'To remove the obnoxious message from your logo,');
              writeln(fout,'delete lines that have the word OBNOXIOUS on them.');
              writeln(fout);
  */

  *sitesused = true;
}


/* the value of the threshold is a guess right now! */

#define threshold       0.00001


/* end module makelogo.warnifsitesused */

/* begin module makelogo.makesymbol */
Static Void makesymbol(afile, height, caps, c)
_TEXT *afile;
double height;
boolean caps;
Char c;
{
  /* write the instructions for the symbol c with height h to file afile.
The move by the amount `height' vertically afterward is done in numchar. */
  if (fabs(height) <= threshold)
    return;
  fprintf(afile->f, "%*.*f (", pwid, pdec, height);
  protectpostscript(afile, c);
  if (caps)
    fputc(capitalize(c), afile->f);
  else
    putc(c, afile->f);
  fprintf(afile->f, ") numchar\n");
}

#undef threshold


/* end module makelogo.makesymbol */

/* begin module makelogo.Ibeam */
Static Void Ibeam(afile, height)
_TEXT *afile;
double height;
{
  /* write the instructions for making an I beam with height (in cm) to file
afile.  Return to the original coordinate afterwards */
  fprintf(afile->f, "%*.*f Ibeam\n", pwid, pdec, height);
}


/* end module makelogo.Ibeam */

/* begin module makelogo.summary */
Static Void summary(f, c, rstotal, varhnb, thefrom, theto)
_TEXT *f;
Char c;
double rstotal, varhnb;
long thefrom, theto;
{
  /* write summary information to file f.  Start each line with character c. */
  if (c != ' ')
    fprintf(f->f, "%c ", c);
  fprintf(f->f, "Rs total is %*.*f", infofield, infodecim, rstotal);
  if (varhnb >= 0)
    fprintf(f->f, " +/- %*.*f bits", infofield, infodecim, sqrt(varhnb));
  else
    fprintf(f->f, " bits (sample error not known)");
  fprintf(f->f, " in the range from %ld to %ld\n", thefrom, theto);
}


/* end module makelogo.summary */

/* begin module makelogo.makenumber */
Static Void makenumber(l, number)
_TEXT *l;
long number;
{
  /* write the PostScript instructions for forming the number in file l */
  fprintf(l->f, "(%ld ) makenumber\n", number);
}


/* end module makelogo.makenumber */

/* begin module makelogo.cosine */
Static Void cosine(afile, amplitude, phase, wavelength, base, xmin, ymin,
		   xmax, ymax, step, dash, thickness)
_TEXT *afile;
double amplitude, phase, wavelength, base, xmin, ymin, xmax, ymax;
long step;
double dash, thickness;
{
  /* write the cosine wave out to afile as defined by the parameters */
  fprintf(afile->f, "%% amplitude  phase  wavelength  base:\n");
  fprintf(afile->f, " %*.*f cm %*.*f cm %*.*f cm %*.*f cm\n",
	  pwid, pdec, amplitude, pwid, pdec, phase, pwid, pdec, wavelength,
	  pwid, pdec, base);
  fprintf(afile->f, "%% xmin ymin xmax ymax step:\n");
  fprintf(afile->f, " %*.*f cm %*.*f cm %*.*f cm %*.*f cm %ld\n",
	  pwid, pdec, xmin, pwid, pdec, ymin, pwid, pdec, xmax, pwid, pdec,
	  ymax, step);
  fprintf(afile->f, "%% dash thickness:\n");
  fprintf(afile->f, " %*.*f cm", pwid, pdec, dash);
  fprintf(afile->f, " %*.*f cm cosine\n", pwid, pdec, thickness);
}


/* end module makelogo.cosine */

/* begin module makelogo.getmark */
Static Void getmark(marks, marksymbol, markbase, markbits, markscale,
		    nextmark)
_TEXT *marks;
Char *marksymbol;
double *markbase, *markbits, *markscale;
long *nextmark;
{
  /* Obtain the information for placing the next mark (markbase,markbits),
its kind (marksymbol) and the integer location (nextmark) */
  if (BUFEOF(marks->f)) {
    *nextmark = LONG_MAX;
    return;
  }
  fscanf(marks->f, "%c%lg%lg%lg%*[^\n]", marksymbol, markbase, markbits,
	 markscale);
  getc(marks->f);
  if (*marksymbol == '\n')
    *marksymbol = ' ';
  if (*marksymbol != 'f' && *marksymbol != 'o') {
    printf("mark symbol in file marks must be one of: \"of\"\n");
    halt();
  }
  if (*markscale <= 0.0) {
    printf("mark scale must be positive\n");
    halt();
  }
  *nextmark = (long)(*markbase);
}


/* end module makelogo.getmark */

/* begin module makelogo.circle */
Static Void circle(f, x, y, radius, fill)
_TEXT *f;
double x, y, radius;
boolean fill;
{
  /* write a circle to file f at (x, y), of given radius and fill it if
"fill" is true */
  fprintf(f->f, " %*.*f cm %*.*f cm %*.*f cm circle\n",
	  pwid, pdec, x, pwid, pdec, y, pwid, pdec, radius);
  if (fill)
    fprintf(f->f, " fill\n");
  else
    fprintf(f->f, " stroke\n");
}


/* Local variables for themain: */
struct LOC_themain {
  _TEXT *logo;
  double barheight;
      /* (real, > 0) height of the vertical bar, in centimeters */
  double charwidth;
      /* (real, > 0) the width of the logo characters, in cm */
  double cmperbit;   /* conversion of bits to centimeters */
  long position_;   /* a location in the aligned sequence (true coordinate) */
  /* true if the sites program was used to create the
     data.  This determines whether an obnoxious warning should be put
     into the logo ... */
  long stacknumber;
  waveparam *wp;   /* wave parameters that define cosine waves */
} ;

Local Void docosinewave(LINK)
struct LOC_themain *LINK;
{
  /* overlay a cosine wave as specified by the parameters */
  double xscale, yscale;   /* converstion factors for x and y for the wave */
  double xmin, ymin;
      /* lower left corner the wave could be in, for the wave */
  double xmax, ymax;
      /* upper right corner the wave could be in, for the wave */
  waveparam *thiswave;   /* the wave we are currently printing */
  waveparam *WITH;

  thiswave = LINK->wp;
  while (thiswave != NULL) {
    WITH = thiswave;
    xscale = LINK->charwidth;
    yscale = LINK->cmperbit;
    xmin = (LINK->position_ - LINK->stacknumber + 1) * xscale;
	/* position */
    xmax = (LINK->position_ + 1) * xscale;   /* position */
    ymin = 0.0;   /* bits */
    ymax = WITH->waveamplitude + LINK->barheight * yscale;   /* bits */
    /* move back to the zero on the plot! */
    fprintf(LINK->logo->f, "gsave\n");
    fprintf(LINK->logo->f, " %*.*f cm 0 translate\n",
	    pwid, pdec, -(LINK->position_ + 1) * LINK->charwidth);
    if (WITH->extreme == 'h')   /* high center point cosine wave */
      cosine(LINK->logo, yscale * WITH->waveamplitude,
	     xscale * (WITH->wavelocation + 0.5), xscale * WITH->wavelength,
	     yscale * (WITH->wavebit - WITH->waveamplitude), xmin, ymin, xmax,
	     ymax, 1L, WITH->dash, WITH->thickness);
    else   /* low center point cosine wave */
      cosine(LINK->logo, -yscale * WITH->waveamplitude,
	     xscale * (WITH->wavelocation + 0.5), xscale * WITH->wavelength,
	     yscale * (WITH->wavebit + WITH->waveamplitude), xmin, ymin, xmax,
	     ymax, 1L, WITH->dash, WITH->thickness);
    /* amplitude */
    /* phase */
    /* the half of a base is to make it put the
       extreme in the middle of the character rather
       than between characters */
    /* wavelength (cm) */
    /* base (cm) */
    /* limiting box (cm) */
    /* step is in points */
    /* dash is in cm */
    /* thickness is in cm */
    /* thickness is in cm */
    fprintf(LINK->logo->f, "grestore\n");
    thiswave = thiswave->next;
  }

  /* step is in points */
  /* dash is in cm */
}


/* end module makelogo.circle */

/* begin module themain */
Static Void themain(symvec, makelogop, colors, marks, wave, logo_)
_TEXT *symvec, *makelogop, *colors, *marks, *wave, *logo_;
{
  /* the main procedure of the program */
  struct LOC_themain V;
  long actualsymbols;
  /* the sum of the actual number of symbols found in
    symvec, as opposed to nl, the number that is SUPPOSED to be there */
  long b;   /* index to a symbol */
  long bar;   /* location before which to print the bar */
  double barbits;
  /* (real) height of the vertical bar, in bits.  If negative,
     then the I-beam will not be displayed */
  boolean barends;   /* put a | before and after each line? */
  double barwidth;
      /* (real, > 0) width of the vertical bar, in centimeters */
  boolean caps;   /* if true, capitalize the logo */
  long stacksperline;   /* the number of characters per line output */
  boolean chilogo;   /* if true, this is a chilogo */
  boolean dobeam;   /* true means we are going to write the Ibeam */
  boolean dostack;   /* true means we are going to write a stack of letters */
  double fbl;   /* frequency of symbol b at position l */
  boolean HalfWhiteIbeam;
  /* true means that no colors are defined in the
     colors so the I-beam error bar is made white when inside the letters */
  long highest;   /* the coordinate of the highest symbol to graph in logo */
  double Ibeamfraction;
  /* The fraction of the Ibeam to draw.  When it is 1,
     the Ibeam is normal.  When it is zero, no vertical line is drawn. At 0.1,
     only 10 percent of the top and bottom parts of the Ibeam are drawn. */
  Char letter;   /* a letter in the alphabet test */
  long l;   /* predicted coordinate */
  double linemove;   /* line separation relative to the barheight */
  long linenumber;   /* number of lines of logo printed so far */
  long linesperpage;   /* the number of lines per page output */
  long lowest;   /* the coordinate of the lowest symbol to graph in logo */
  Char marksymbol;   /* a symbol to mark on the logo */
  double markbase;   /* location in bases of the marksymbol */
  double markbits;   /* location in bits of the marksymbol */
  double markscale;
      /* factor by which to change the size of the marksymbol */
  long nextmark;   /* the position to place the next mark */
  long nl;   /* number of symbols at position l */
  boolean numbering;   /* if true, numbers are made below the logo */
  boolean outline;   /* if true, characters are made in outline */
  long page;   /* page number we are beginning to write out */
  long previousposition;   /* the previous value of position */
  double radius;   /* radius of a circle mark */
  double rotation;   /* angle in degrees to rotate the figure */
  double rsl;   /* information at position l */
  double rsvar;   /* variance of information at position l */
  double rstotal;   /* sum of the rsl for the whole logo */
  double varhnb;   /* variance of rstotal for the whole logo */
  boolean showingbox;   /* if true, show a box around each character */
  double shrink;   /* the factor by which to shrink symbols */
  boolean shrinking;   /* whether or not to shrink */
  boolean sitesused;
  /* the number of the stack of symbols.  Unlike the
     position variable, it begins at 1.  It is used to decide when to break
     the logo onto the next line */
  long symbols;   /* number of symbols possible */
  strings *thestrings;   /* set of user defined strings */
  double x;   /* an x coordinate on the logo */
  double xcorner;
      /* the lower left corner of the x-axis on the paper (cm) */
  double y;   /*  a y coordinate on the logo */
  double ycorner;
      /* the lower left corner of the y-axis on the paper (cm) */
  _TEXT TEMP;

  V.logo = logo_;
  printf("makelogo %4.2f\n", version);

  readparameters(makelogop, &lowest, &highest, &bar, &xcorner, &ycorner,
		 &rotation, &V.charwidth, &V.barheight, &barwidth, &barbits,
		 &Ibeamfraction, &barends, &showingbox, &outline, &caps,
		 &stacksperline, &linesperpage, &linemove, &numbering,
		 &shrinking, &shrink, &thestrings);
  readwaveparameters(wave, &V.wp);

  TEMP.f = stdout;
  *TEMP.name = '\0';
  warnifsitesused(symvec, &TEMP, &sitesused);

  V.cmperbit = V.barheight / fabs(barbits);   /* converts bits to cm */

  if (*marks->name != '\0') {
    if (marks->f != NULL)
      marks->f = freopen(marks->name, "r", marks->f);
    else
      marks->f = fopen(marks->name, "r");
  } else
    rewind(marks->f);
  if (marks->f == NULL)
    _EscIO(FileNotFound);
  RESETBUF(marks->f, Char);
  getmark(marks, &marksymbol, &markbase, &markbits, &markscale, &nextmark);

  if (*colors->name != '\0') {
    if (colors->f != NULL)
      colors->f = freopen(colors->name, "r", colors->f);
    else
      colors->f = fopen(colors->name, "r");
  } else
    rewind(colors->f);
  if (colors->f == NULL)
    _EscIO(FileNotFound);
  RESETBUF(colors->f, Char);
  if (BUFEOF(colors->f) && !outline) {
    printf("Half-White Ibeams are used because the symbols are solid black.\n");
    HalfWhiteIbeam = true;
  } else
    HalfWhiteIbeam = false;

  if (*symvec->name != '\0') {
    if (symvec->f != NULL)
      symvec->f = freopen(symvec->name, "r", symvec->f);
    else
      symvec->f = fopen(symvec->name, "r");
  } else
    rewind(symvec->f);
  if (symvec->f == NULL)
    _EscIO(FileNotFound);
  RESETBUF(symvec->f, Char);
  if (*V.logo->name != '\0') {
    if (V.logo->f != NULL)
      V.logo->f = freopen(V.logo->name, "w", V.logo->f);
    else
      V.logo->f = fopen(V.logo->name, "w");
  } else {
    if (V.logo->f != NULL)
      rewind(V.logo->f);
    else
      V.logo->f = tmpfile();
  }
  if (V.logo->f == NULL)
    _EscIO(FileNotFound);
  SETUPBUF(V.logo->f, Char);
  fprintf(V.logo->f, "%%!PS-Adobe-\n");   /* Minimally conforming */
  fprintf(V.logo->f, "%%%%Title: makelogo %4.2f\n", version);
  if (!BUFEOF(symvec->f)) {
    while (P_peek(symvec->f) == '*') {
      fprintf(V.logo->f, "%% ");
      copyaline(symvec, V.logo);
    }
    fscanf(symvec->f, "%ld%*[^\n]", &symbols);
    getc(symvec->f);
    printf("%ld symbols.\n", symbols);
  }
  page = 0;
  startpostscript(V.logo, colors, lowest, highest, bar, xcorner, ycorner,
		  rotation, V.charwidth, V.barheight, barwidth, barbits,
		  Ibeamfraction, barends, showingbox, outline, caps,
		  stacksperline, linesperpage, linemove, numbering, shrinking,
		  shrink, thestrings, HalfWhiteIbeam);
  /* not in use:
                          sitesused);
  */

  if (BUFEOF(symvec->f)) {  /* do an alphabetic test logo */
    printf("Alphabet Logo\n");
    fprintf(V.logo->f, "%% Alphabet Logo\n");
    fprintf(V.logo->f, "startpage startline\n");
    if (barends)
      fprintf(V.logo->f, "makebar\n");
    fprintf(V.logo->f, "%% find out how high the bar is in centimeters:\n");
    fprintf(V.logo->f, "/barincm barheight cmfactor div def\n");
    for (b = 'A'; b <= 'Z'; b++) {
      V.position_ = b + 1 - 'A';
      if (V.position_ == bar)
	fprintf(V.logo->f, "makebar\n");
      if (V.position_ >= lowest && V.position_ <= highest) {
	if (numbering)
	  makenumber(V.logo, V.position_);
	if (!caps)
	  letter = _tolower(b);
	else
	  letter = (Char)b;
	fprintf(V.logo->f, "  gsave barincm (%c) numchar grestore shift\n",
		letter);
      }
    }
    if (barends)
      fprintf(V.logo->f, "makebar\n");
    fprintf(V.logo->f, "endline endpage\n");
    return;
  }
  /* the main loop; read through the symvec, sort the characters and then
     create the graphic.  The program assumes that the header of symvec has
     been skipped and that symbols is read in already */
  rstotal = 0.0;
  varhnb = 0.0;
  linenumber = 0;   /* trigger start of a page */
  l = lowest;
  V.position_ = lowest;
  chilogo = false;
  while (!BUFEOF(symvec->f)) {
    previousposition = V.position_;   /* keep track of previous position */
    fscanf(symvec->f, "%ld%ld%lg%lg%*[^\n]", &V.position_, &nl, &rsl, &rsvar);
    getc(symvec->f);

    /* read through the symbols and see if they are really all there.
    This check is useful when someone writes a symvec themselves. */
    actualsymbols = 0;
    for (b = 0; b < symbols; b++) {
      while (P_peek(symvec->f) == ' ')   /* skip leading blanks */
	getc(symvec->f);
      fscanf(symvec->f, "%c%ld%*[^\n]", &map[b].b, &map[b].n);
      getc(symvec->f);
      if (map[b].b == '\n')
	map[b].b = ' ';
      if (map[b].n < 0) {
	if (!chilogo) {
	  chilogo = true;
	  printf("This is a Chilogo! - Upside down letterswill be produced\n");
	}
      }
      if (chilogo)
	actualsymbols += abs(map[b].n);
      else
	actualsymbols += map[b].n;
    }
    if (!chilogo && nl != actualsymbols ||
	chilogo && abs(nl - actualsymbols) > 1.5) {
      printf("\nTHE SYMVEC FILE IS BAD!\n");
      printf("At position %ld the sum of symbols found is %ld\n",
	     V.position_, actualsymbols);
      printf("But the noted number is %ld\n", nl);
      halt();
    }
    /* in the case of the chilogo, the sum of rounded numbers
       may be off by 1 */

    /* create the PostScript code for this stack of symbols */
    if (V.position_ < lowest || V.position_ > highest)
      continue;

    rstotal += rsl;
    varhnb += rsvar;

    /* put the symbols into order of their frequency */
    quicksort(1, (int)symbols);

    /* track the line number */
    if (linenumber == 0) {
      fprintf(V.logo->f, "%%%%Page:? ?\n");    /* don't specify page # */
      fprintf(V.logo->f, "\nstartpage\n");

      page++;
      if (page > 1)
	printf("writing page %ld\n", page);

      V.stacknumber = 0;   /* trigger line to start */
    }

    /* track the number of stacks on the line */
    if (V.stacknumber == 0) {
      linenumber++;
      fprintf(V.logo->f, "startline %% line number %ld\n", linenumber);
    }
    V.stacknumber++;

    if (V.position_ == bar) {
      if (!barends || V.stacknumber != 1) {
	fprintf(V.logo->f, "%% before coordinate %ld: make the bar\n",
		V.position_);
	fprintf(V.logo->f, "makebar\n");
      }
    }

    fprintf(V.logo->f, "%% at coordinate %ld\n", V.position_);

    /* allow user to unearth the call to makenumber by hand */
    if (!numbering)
      fprintf(V.logo->f, "%% ");
    makenumber(V.logo, V.position_);

    /* avoid plotting tiny Rs values at all (PostScript blows up
       on the Apple LaserWriter - and no plot comes out.) */
    if ((long)floor(pnum * rsl * V.cmperbit + 0.5) > 0.0)
      dostack = true;
    else
      dostack = false;

    /* if rsvar is negative, this indicates that the
       sample variation is unknown.  (see the sites.p program) */
    dobeam = false;
    if (rsvar >= 0.0) {
      if (barbits > 0.0)
	dobeam = true;
    } else if (!sitesused) {
      printf("WARNING: negative Rs variation found in symvec,\n");
      printf("but the data are not from the sites program\n");
      printf("possible program or data error.\n");
    }

    if (dostack || dobeam)
      fprintf(V.logo->f, "gsave\n");
    if (dostack) {
      for (b = 0; b < symbols; b++) {
	/* draw one character in the stack of characters */
	fbl = (double)map[b].n / nl;
	makesymbol(V.logo,
	  (double)((long)floor(pnum * fbl * rsl * V.cmperbit + 0.5)) /
	  ((pnum < 0) ? -pnum : pnum), caps, map[b].b);
	/* note: the abs(pnum) makes sure that the sign of pnum
	   DOES get passed to makesymbol, so that upside down
	   symbols can be printed! */
      }
    }
    if (dobeam && !sitesused)
      Ibeam(V.logo, sqrt(rsvar) * V.cmperbit);
    if (dostack || dobeam)
      fprintf(V.logo->f, "grestore\n");

    /* make the appropriate marks within this base interval */
    if (V.position_ >= nextmark) {
      do {
	if (V.position_ == nextmark) {
	  fprintf(V.logo->f, "gsave\n");
	  x = (markbase - nextmark + 0.5) * V.charwidth;
	  y = markbits * V.cmperbit;
	  if (marksymbol == 'o' || marksymbol == 'f') {
	    radius = markscale * V.charwidth / 2.0;
	    switch (marksymbol) {

	    case 'f':
	      circle(V.logo, x, y, radius, true);
	      break;

	    case 'o':
	      circle(V.logo, x, y, radius, false);
	      break;
	    }
	  }
	  fprintf(V.logo->f, "grestore\n");
	}
	/* do the mark */
	/*
writeln(output,marksymbol,' ',markbase:5:3,
	                          ' ',markbits:5:3,' ',markscale:5:3,' ',nextmark:5);
	*/
	/* get the next one */
	getmark(marks, &marksymbol, &markbase, &markbits, &markscale,
		&nextmark);
      } while (V.position_ >= nextmark);
    }

    fprintf(V.logo->f, "shift\n");   /* move away from this stack */
    if (V.stacknumber == stacksperline || V.position_ == highest)
      docosinewave(&V);

    if (linenumber == linesperpage && V.stacknumber == stacksperline)
    {  /* complete the page */
      if (highest == bar - 1) {
	if (!barends) {
	  fprintf(V.logo->f,
		  "%% bar at end of logo: make the bar before position %ld\n",
		  V.position_);
	  fprintf(V.logo->f, "makebar\n");
	}
	/* or (stacknumber <> 1) residue from main call */
      }

      fprintf(V.logo->f, "endline\n");
      V.stacknumber = 0;   /* trigger for restarting the line */
      fprintf(V.logo->f, "endpage\n");
      linenumber = 0;   /* trigger for restarting the page */
    }


    if (V.stacknumber == stacksperline) {  /* complete the line */
      fprintf(V.logo->f, "endline\n");
      V.stacknumber = 0;   /* trigger for restarting the line */
    }

    /* check the coordinate system */
    while (l != V.position_ && l <= highest) {
      printf("\nWARNING: symvec does not contain data for position %ld\n", l);
      if (l == 0 && lowest < 0 && highest > 0 && V.position_ == 1 &&
	  previousposition == -1) {
	printf("It seems that you don't have a zero coordinate.\n");
	printf(
	  "\"... the invention, probably by the Hindus, of the digit zero has been\n");
	printf(
	  "described as one of the greatest importance in the history of mathematics.\"\n");
	printf("--- Encyclopaedia Britannica (1:1175, 1982)\n");
	printf("Please use a zero!\n");
	if (*V.logo->name != '\0') {
	  if (V.logo->f != NULL)
	    V.logo->f = freopen(V.logo->name, "w", V.logo->f);
	  else
	    V.logo->f = fopen(V.logo->name, "w");
	} else {
	  if (V.logo->f != NULL)
	    rewind(V.logo->f);
	  else
	    V.logo->f = tmpfile();
	}
	if (V.logo->f == NULL)
	  _EscIO(FileNotFound);
	SETUPBUF(V.logo->f, Char);
	halt();
      }
      putchar('\n');
      l++;   /* predict the next position */
    }
    l++;   /* predict the next position */
  }

  if (V.position_ < highest) {
    printf("\nWARNING: Highest position requested was not found in symvec\n\n");
    /* in this case, the cosine wave was not done above, so do it now */
    if (V.stacknumber != 0)
      docosinewave(&V);
  }

  /* make sure that the end line and page is done! */
  if (V.stacknumber != 0)
    fprintf(V.logo->f, "endline\n");
  if (linenumber != 0)
    fprintf(V.logo->f, "endpage\n");

  summary(V.logo, '%', rstotal, varhnb, lowest, highest);
  TEMP.f = stdout;
  *TEMP.name = '\0';
  summary(&TEMP, ' ', rstotal, varhnb, lowest, highest);


  /* do the regular logo */
}


/* end module themain */

main(argc, argv)
int argc;
Char *argv[];
{
  PASCAL_MAIN(argc, argv);
  if (setjmp(_JL1))
    goto _L1;
  logo.f = NULL;
  strcpy(logo.name, "logo");
  wave.f = NULL;
  strcpy(wave.name, "wave");
  marks.f = NULL;
  strcpy(marks.name, "marks");
  colors.f = NULL;
  strcpy(colors.name, "colors");
  makelogop.f = NULL;
  strcpy(makelogop.name, "makelogop");
  symvec.f = NULL;
  strcpy(symvec.name, "symvec");
  /*   Look for input file name suffix   JGH*/
   if(argc > 1)
   {
      strcat(logo.name, "."); strcat(logo.name, argv[1]);
      strcat(symvec.name, "."); strcat(symvec.name, argv[1]);
      strcat(makelogop.name, "."); strcat(makelogop.name, argv[1]);
      strcat(colors.name, "."); strcat(colors.name, argv[1]);  /*SP*/
   }

  themain(&symvec, &makelogop, &colors, &marks, &wave, &logo);
_L1:
  if (symvec.f != NULL)
    fclose(symvec.f);
  if (makelogop.f != NULL)
    fclose(makelogop.f);
  if (colors.f != NULL)
    fclose(colors.f);
  if (marks.f != NULL)
    fclose(marks.f);
  if (wave.f != NULL)
    fclose(wave.f);
  if (logo.f != NULL)
    fclose(logo.f);
  exit(EXIT_SUCCESS);
}



/* End. */
