program genpic(histog,genpicp,picout,output);
(* convert genhis output to pic input

  Dr. Thomas D. Schneider
  National Institutes of Health
  National Cancer Institute
  Center for Cancer Research Nanobiology Program
  Molecular Information Theory Group
  Frederick, Maryland  21702-1201
  toms@ncifcrf.gov
  permanent email: toms@alum.mit.edu (use only if first address fails)
  http://www.ccrnp.ncifcrf.gov/~toms/

module libraries required: delman, prgmods, dops *)

label 1; (* end of program *)

const

(* begin module version *)
   version = 2.61; (* of genpic.p 2007 Nov 28
2007 Nov 28, 2.61: bug? x axis is fixed?
2007 Aug 31, 2.60: clean up
2007 Aug 31, 2.59: control total height of graph, not just boxes
2007 Aug 30, 2.58: fix doaxis (continued)
2007 Aug 30, 2.57: fix doaxis
2007 Aug 30, 2.56: add tic marks at end of x axis
2007 Aug 30, 2.55: add parameters for x axis number positions
2007 Aug 30, 2.54: upgrade from dops modules
2007 Aug 30, 2.53: add parameters for y axis number positions, x axis
                   bug fix in doaxis
2007 Aug 29, 2.52: more clean up and remove fixed parameters
2007 Aug 29, 2.51: clean up and remove fixed parameters
2007 Aug 29, 2.50: refine y axis
2007 Aug 29, 2.49: develop y axis parameter control
2007 Aug 29, 2.48: add y axis - functional!!
2007 Aug 03, 2.47: cleanup
2007 Aug 03, 2.46: bug crash
                   error in exponentiation (Result too large)
                     (error #700 at 18d2b)
                   Plotting the gaussian for large standard deviations
                   gives exponentiation of an extremely small number.
                   Put a tolerance in instead.
2007 Jun 14, 2.45: modulo failed
2006 Dec 04, 2.44: modulo multiplier - fix readln bug
2006 Nov 15, 2.43: modulo multiplier
2005 Aug  7, 2.42: need to reset picout after progmod upgrade
2005 Aug  6, 2.41: PageOrientation fails.  Use 45 rotate 45 rotate
                   to fool acrobat into not rotating the page ...
2005 Aug  6, 2.40: use: PageOrientation to force page orientation!
2005 Aug  6, 2.39: consider drawing the display differently. (failed)
2005 Aug  6, 2.38: display in acrobat from pdf rotates image!
                   If one rotates an image by 90 degrees, then acrobat
                   rotates it back!!  STOOPID!
2005 Jan 11, 2.37: GPCC won't allow real without decimals in rotate.
2005 Jan  7, 2.36: fix output for ymaximum
2004 Feb  6, 2.35: clean up
2004 Feb  6, 2.34: segmentation fault for 2 other titles - not read in properly
2003 Aug 22, 2.32: overlay curve must be fixed too
2003 Aug 22, 2.31: use version number to retain old behavior!
2003 Aug 21, 2.31: document the graph shift bug in main documentation.
2003 Aug 21, 2.30: bug: graph shifts right depending on number of '*'
                   comment lines!  This bug was removed.  This will ALTER
                   the required x coordinate of ALL GRAPHS!!!
2002 Feb 21, 2.28: make additional titles work
2002 Feb 21, 2.27: cleanup documentation
2002 Feb 21, 2.26: program upgrades old parameter files correctly
2002 Feb 21, 2.22: encapsulated postscript and bounding box controls
                   second title has size control independent of first
vertical bar at zero coordinate: 1996 Oct 8
any number of other titles:  1996 Oct 1
rebuilt to give titles and more parameter control: 1996 August 12
rebuilt parameter file, x, y, rotation: 1995 October 25
previous changes: 1992 November 16
origin 1985 July 21 *)
updateversion = 2.50; (* defines lowest acceptable current parameter file *)
bugversion226 = 2.26; (* parameters with versions at or lower than this will function
  the same as with the bug reported on 2003 aug 21 for version 2.30.  You
  need not do anything with old parameter files. *)
(* end module version *)

(* begin module describe.genpic *)
(*
name
      genpic: convert genhis output to pic input

synopsis
      genpic(histog: in, genpicp: in, picout: out, output: out)

files
      histog: the output of the genhis program

      genpicp: parameters to control the histogram are one per line.

         The first line must be the version number of the this program.  This
         allows the program to recognize when the parameter file is old.  If
         the version is less than 2.26, genpic will upgrade the genpicp
         file.

         x: x coordinate of graph start on the page (cm)

         y: y coordinate of graph start on the page (cm)

         rotation: angle to rotate the graph

         graphheight: height of the core graph (cm).

            When there is no y axis (original design of the program)
            this number determines the height of the highest histogram
            box ("boxheight").

            When there is a y axis, it is the length of
            the y axis.

         boxwidth: width of the histogram boxes. (cm)

         intervalsize: the space for the interval number. (cm)

         histogramvalue: the space for the histogram value. (cm)

         boxshift: how much to shift the boxes up relative to the numbers. (cm)

         ifield: number of characters devoted to the interval

         idecimal: number of characters devoted to the interval's decimal places

         nfield: number of characters devoted to the number of numbers

         modulo: an integer that determines which interval numbers are
            shown.  Modulo = 1 gives all numbers, modulo = 2 gives every
            even number, etc.

            If there is a second real number on the line, the
            modulomultiplier, then the interval numbers are first
            multiplied by this number.  This allows one to control
            intervals below 1.  (This doesn't work quite right yet.)

   FIRST COLUMN TITLE
         column name size (integer): the size in points of the column names
         relative column 1 name x coordinate adjustment (cm): real number
         relative column 1 name y coordinate adjustment (cm): real number
         first column name: the entire line defines the name

   SECOND COLUMN TITLE
NEW PARAMETER as of 2002 Feb 21:
         column name size (integer): the size in points of the column names
         relative column 1 name x coordinate adjustment (cm): real number
         relative column 1 name y coordinate adjustment (cm): real number
         second column name: the entire line defines the name

   OTHER TITLES
previously undocumented PARAMETER as of 2002 Feb 21:
         othertitles (integer): How many more titles to do

         title name size (integer): the size in points of the title
         title x coordinate relative adjustment (cm): real number
         title y coordinate relative adjustment (cm): real number
         title name: the entire line defines the title

   EDGE CONTROLS, on one line:
         edgecontrol edgeleft, edgeright, edgelow, edgehigh:  edgecontrol is
         a single character that controls how the bounding box of the figure
         is handled.  If it is 'n' then the initial bounding box will be the
         page parameters defined in constants inside the program (llx, lly,
         urx, ury and changes as set by the previous parameter line).
         Otherwise the program will attempt to determine a good starting
         bounding box.  The next 4 parameters are four real numbers that
         define the edges around the figure in cm.  To allow a graph to be
         imbedded into another figure, its size must be defined in PostScript
         (with %%BoundingBox).  By setting these four numbers, the edges are
         defined.  Negative values are allowed; this will move the edges
         *inward*.

NEW PARAMETERS as of 2007 Aug 30:

   X-AXIS CONTROLS, on one line:
        xaxiscontrol: char; x means to plot an X axis
        xaxismax: integer;  maximum count to plot
            x axis interval control:
        xaxisintervals: integer;  interval size, counts
        xaxissubintervals: integer;  number of sub-intervals
            x axis tic mark controls:
        xaxisticlength: real; length of tic mark
        xaxisticdx: real; x position of number relative to tic mark
        xaxisticdy: real; y position of number relative to tic mark

   Y-AXIS CONTROLS, on one line:
        yaxiscontrol: char; y means to plot a Y axis
        yaxismax: integer;  maximum count to plot
            y axis interval control:
        yaxisintervals: integer;  interval size, counts
        yaxissubintervals: integer;  number of sub-intervals
            y axis tic mark controls:
        yaxisticlength: real; length of tic mark
        yaxisticdx: real; x position of number relative to tic mark
        yaxisticdy: real; y position of number relative to tic mark

      picout: the data in histog are converted to PostScript
         All lines describing the data are comments.

      output: messages to the user.

description

      The genhis program generates a histogram in simple character format.
      The program genpic converts this simple histogram into PostScript
      commands.  Therefore, one can imbed output from genhis in the text of a
      paper.  A vertical line is given at coordinate zero.

examples

an example genpicp:

2.26  version of genpicp that this parameter file is designed for.
1.0   x cm
10.0  y cm
0     rotation
4     graphheight, height of the graph, cm
0.3   boxwidth, width of the histogram boxes, cm
0.6   intervalsize, space for interval number, cm
0.6   histogramvalue, space for histogram value, cm
0     boxshift, shift boxes up relative to numbers, cm
5     field: number of characters devoted to the interval
1     decimal: number of characters devoted to the interval's decimal places
5     field: number of characters devoted to the number of numbers
1     modulo: multiples of this number are shown
0     barlocation: where to put a vertical bar
12    column name size (points)
0     relative column 1 name x coordinate adjustment (cm)
0.20  relative column 1 name y coordinate adjustment (cm)
second column name (values)
12    column name size (points)
0     relative column 2 name x coordinate adjustment (cm)
0.40  relative column 2 name y coordinate adjustment (cm)
first column name (number)
14    title name size (points)
-5.2  relative title x coordinate adjustment (cm)
0.0   relative title y coordinate adjustment (cm)
overall title
1     How many more titles to do
12    other title name size (points)
0.0   relative title x coordinate adjustment (cm)
-0.8  relative title y coordinate adjustment (cm)
This is an additional title
n 0 0 0 0 edgecontrol (p=page), edgeleft, edgeright, edgelow, edgehigh in cm
x 17 5 5 0.1 -0.00 -0.35 xaxis: control max int subint ticlength ticdx ticdy
y 15 5 5 0.1 -0.12 -0.12 yaxis: control max int subint ticlength ticdx ticdy

see also

      {program that produces input to this program:} genhis.p

      {example parameter file:} genpicp

author
      Thomas D. Schneider

bugs

2003 Aug 21, 2.30: WARNING: ALL PARAMETER FILES WILL HAVE TO BE
ADJUSTED.  I discovered a bug in which the graph shifts right
depending on number of '*' comment lines in the histog file.  This bug
was removed.  This will ALTER the required x coordinate of ALL
GRAPHS!!!  It is a nasty bug because all parameter files depended on
this and each one was adjusted (unintentionally) by hand to account
for it.  It is a holdover from some time (perhaps) when the comment
lines were printed on the output.  Since we don't do that anymore, it
is not needed.  The effect of having the bug was that if one generated
graphs with different numbers of header line comments, the graphs
would shift depending on the number of header lines and so the graphs
would be different.

technical note
       defaults for the page parameters are in module genpic.const.

NEW PARAMETERs as of 2002 Feb 21:
edgecontrol edgeleft, edgeright, edgelow, edgehigh

*)
(* end module describe.genpic *)

(* begin module genpic.const *)
  (* defaults: *)
  dx = 1.0; (* x coordinate of graph start *)
  dy = 3.0; (* y coordinate of graph start *)
  drotation = 0; (* angle to rotate the graph *)
  dgraphheight = 5.0; (* height of the graph *)
  dboxwidth = 0.15; (* width of the histogram boxes *)
  dintervalsize = 1.25; (* the space for the interval in cm *)
  dhistogramvalue = 1.25; (* the space for the histogram value in cm *)
  dboxshift = -0.15; (* how much to shift the boxes up
         relative to the numbers *)
  difield = 8; (* field width of interval numbers *)
  didecimal = 2; (* decimal places of interval numbers *)
  dnfield = 5; (* field width of number numbers *)
  dmodulo = 1; (* modulo *)
  dmodulomultiplier = 1.0; (* default modulo multiplier*)

  (* The following bounding box is for the Canon Color Laser Copier 800S. *)
  defaultllx =  10.08; (* lower left x *)
  defaultlly =   8.91; (* lower left y *)
  defaulturx = 588.06; (* upper left x *)
  defaultury = 779.85; (* upper left y *)

(* end module genpic.const *)

(* begin module pic.const *)
   pi = 3.14159265354; (* circumference divided by diameter of circle *)
   picwidth = 8; (* width of numbers printed to the file *)
   picdecim = 5; (* number of decimal places for numbers *)
   charwidth = 0.15875; (* the width of characters in cm (ie, cm/char)
                        this allows centering of strings. *)
   (* note: for the Times-Roman  font, 0.0625 is a good value.
            for the Courier-Bold font, 0.08   is a good value. *)
   dotfactor = 0.015875; (* the size of dots *)
{
   defscale = 72; (* default scale factor.  coordinate units per in *)
}
   defscale = 28.35; (* default scale factor.  coordinate units per cm *)
{ making this change would be a big shock to all the programs that
use it, unfortunately.  A major user is xyplo. }
(* end module pic.const version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module interact.const *)
(* begin module string.const *)
      maxstring = 2000; (* the maximum string *)
(* end module string.const version = 5.27; (@ of prgmod.p 2005 Aug 06 *)
(* end module interact.const version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module filler.const *)
      fillermax = 50; (* the size of the filler array for a string *)
(* end module filler.const version = 5.27; (@ of prgmod.p 2005 Aug 06 *)

(* begin module histogram.const *)
      maxslots = 1000;  (* maximum number of slots in the histogram *)
      defslots = 100;  (* the default number of slots *)
      pageheight = 105;  (* room on page for plotting; used to set scaling *)
      dch = '+';  (* character for plotting data *)
      sch = ':';  (* character for plotting standard *)
      bch = '*';  (* character for plotting coincidence of standard and data *)
(* end module histogram.const version = 1.33;  (@ of genhis, 1985 dec 19 *)

type
(* begin module genpic.histogram.type *)
      plots = (none,gaussian,poisson);  (* the types of standard plots
                                           that can be done *)
      endpoints = (start,stop);  (* defines the range for plotting *)
      rhistarray = record
{
         numbers: array[1..maxslots] of integer;  (* histogram arrays *)
}
         (* for THIS program, use real numbers! *)
         numbers: array[1..maxslots] of real;  (* histogram arrays *)
         range: array[endpoints] of real; (* range of the data recorded *)
         interval: real;  (* the size of the histogram slots *)
         slots: integer;  (* the number of slots *)
      end;
(* origin from  version = 1.33;  (@ of genhis, 1985 dec 19 *)
(* end module genpic.histogram.type *)

(* begin module genpic.histdata *)
      histdata = record (* the data about a histogram in the histog
                           file from the genhis program *)
         column: integer; (* the data column used *)
         entries: integer; (* numbers are in the file *)
         minimum: real; (* the minimum number *)
         maximum: real; (* the maximum number *)
         mean: real; (* the MEA *)
         stdev: real; (* the STANDARD DEVIATIO *)
         sem: real; (* the STANDARD ERROR OF THE MEAN (SEM) *)
         variance: real; (* the variance *)
         uncertainty: real; (* the uncertainty in bits *)
         computeduncertainty: real; (* the computed uncertainty in bits
                                       (Shannon p.57) *)
         start: real; (* start of the range of data plotted *)
         stop: real; (*  stop  of the range of data plotted *)
         xinterval: real; (* x-axis interval *)
         slots: integer; (* the number of intervals *)
         ymaximum: integer; (* highest count in the graph *)
         yaxisscale: real; (* the y-axis scale *)
         plot: char; (* type of graph, g = gaussian, p = poisson *)
      end;
(* end module genpic.histdata *)

(* begin module interact.type *)
(* begin module string.type *)
   stringptr = ^string; (* pointer to a string *)
   string = record (* a string of characters *)
      letters: array[1..maxstring] of char; (* the letters in the string *)
      length: integer; (* the number of characters in the string *)
      current: integer; (* the letter we are working on *)
      next: stringptr; (* the next string in a series *)
   end;
(* end module string.type version = 5.27; (@ of prgmod.p 2005 Aug 06 *)
(* end module interact.type version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module trigger.type *)
      trigger = record (* an object to be searched for *)
         seek: string; (* the characters looked for *)
         state: integer; (* how close to triggering we are *)
         skip: boolean; (* trigger not found- skip the line *)
         found: boolean (* the trigger was found *)
      end;
(* end module trigger.type version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module filler.type *)
      (* the following is an array used to fill a string.
      it is convenient to have it much shorter than the maxstring, so that
      it is easy to fill the string using procedure fillstring.
      the user must declare the value of constant fillermax. *)
      filler = packed array[1..fillermax] of char;
(* end module filler.type version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module genpic.title *)
   titleptr = ^title; (* pointer to a title *)
   title = record
      titlenamesize: integer; (* the title name size in points *)
      titlex: real; (* the title x coordinate adjustment (cm) *)
      titley: real; (* the title y coordinate adjustment (cm) *)
      letters: string; (* the title *)
      next: titleptr; (* the next title *)
   end;
(* end module genpic.title *)

(* ********************************************************************** *)

var
(* begin module genpic.var *)
      histog, (* output of genhis program *)
      genpicp, (* control parameters for genpic *)
      picout: (* output of this program, graph in pic language *)
         text;
      (* see notes for version 2.30 for why this is here *)
      parameterversion: real; (* parameter version number *)
(* end module genpic.var *)

(* begin module pic.var *)
   inpicture: boolean; (* true if we are drawing the picture,
                          ie, startpic has been called *)
   picxglobal, picyglobal: real; (* absolute location in the graph *)
   pictolerance: real; (* 10 raised to the picwidth,
      to detect values close to zero *)

   scale: real; (* scale factor.  graphic coordinate units per cm *)

(* NONSTANDARD for efficient use of postscript, keep track of
whether there is a current path *)
   inpath: boolean;

(* NONSTANDARD keep track of number of segments drawn so that
they can be stroked.  This (probably) solves the problem of the
Apple printer dying because it can't handle the data. *)
   segments: integer;

   xsideold, ysideold: real; (* current size of a rectangle.  see rectsize *)
(* end module pic.var version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module halt *)
procedure 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. *)
begin
      writeln(output,' program halt.');
      goto 1
end;
(* end module halt version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module interact.clearstring *)
(* begin module clearstring *)
(* These modules clear strings in various ways *)
(* ---- *)
procedure emptystring(var ribbon: string);
(* empty the contents of the string but do NOT
remove the pointer.  This is useful for clearing
one string within a linked list of them. *)
var   index: integer; (* to the ribbon *)
begin (* clearstring *)
   with ribbon do begin
      for index := 1 to maxstring do letters[index] := ' ';
      length := 0;
      current := 0;
   end
end; (* emptystring *)
(* ---- *)
procedure clearstring(var ribbon: string);
(* empty the string and remove the pointer *)
begin (* clearstring *)
   with ribbon do begin
      emptystring(ribbon);
      next := nil;
   end
end; (* clearstring *)
(* ---- *)
procedure initializestring(var ribbon: string);
(* start the string with a nil pointer.   This routine
should be called before doing linked list work.  This allows
the standard string routines to clear the string without
killing the pointer.  This is now deprecated, do not use it
since clearstring still clears the next pointer. *)
begin (* initializestring *)
   writeln(output,'remove initializestring routine!');
   writeln(output,'replace it with clearstring routine!');
   halt; (* to force deprecation *)
   clearstring(ribbon);
   ribbon.next := nil;
end; (* initializestring *)
(* end module clearstring version = 5.27; (@ of prgmod.p 2005 Aug 06 *)
(* end module interact.clearstring version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module interact.writestring *)
(* begin module writestring *)
procedure writestring(var tofile: text; var s: string);
(* write the string s to file tofile, no writeln *)
var   i: integer; (* index to s *)
begin (* writestring *)
      with s do for i := 1 to length do write(tofile, letters[i])
end; (* writestring *)
(* end module writestring version = 5.27; (@ of prgmod.p 2005 Aug 06 *)
(* end module interact.writestring version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module trigger.proc *)
(* this module allows one to scan a series of characters, as from
an array or a file, and to "trigger" or detect a simple string
in the series.  the advantage of the trigger is that several triggers
can "observe" a stream of characters at once, each looking for a
different thing.
some other modules required: interact.const, interact.type *)

procedure resettrigger(var t: trigger);
(* reset the trigger to ground state *)
begin (* resettrigger *)
      with t do begin
         state := 0;
         skip := false;
         found := false
      end
end; (* resettrigger *)

procedure testfortrigger(ch: char; var t: trigger);
(* look at the character ch.
   if it is part of the trigger (at the current trigger state),
       then the trigger state goes higher.
   if it is not part of the trigger then the trigger state is reset,
      skip is true and one should skip onward to find the trigger.
   if the trigger is found, found is true.
1996 Sep 12: Bug found!  In the case of a trigger "ab", the program
used to miss it for situations like "aab".  This was because at the
first a it would step up.  Then it would see the second a and recognize
that was not part of ab.  It would fail to realize that it could be
the start of a new one.  The code now accounts for that possibility. *)
begin (* testfortrigger *)
      with t do begin
         state := succ(state);
{
writestring(list,seek);
writeln(list,'testfortrigger seek.letters[',state:1,']:',
seek.letters[state],' ch:',ch);
}
         if seek.letters[state] = ch
         then begin
            skip := false;
            if state = seek.length then found := true
                                   else found := false
         end
         else begin
            (* it failed.  But wait!  It could be the beginning
            of a NEW trigger string! *)
            if seek.letters[1] = ch then begin
               state := 1;
               skip := false;
               found := false
            end
            else begin (* reset trigger *)
               state := 0;
               skip := true;
               found := false
            end
         end
      end
end; (* testfortrigger *)
(* end module trigger.proc version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module filler.fillstring *)
procedure fillstring(var s: string; a: filler);
(* this procedure makes it reasonably easy to fill the string s with
characters.  one calls the procedure as: *)
(*                           1         2         3         4         5 *)
(*                  12345678901234567890123456789012345678901234567890 *)
(*   fillstring(s, 'this-is-the-string                                ');
the two comments make it easy to line the characters up. also, for this
example, it was assumed that the length of filler as defined by the
constant fillermax was 50. *)
var
      length: integer; (* of the string without trailing blanks *)
      index: integer; (* of s *)
begin (* fillstring *)
      clearstring(s);
      length := fillermax;
      while (length > 1) and (a[length] = ' ') do length := pred(length);
      if (length = 1) and (a[length] = ' ') then begin
         writeln(output, 'fillstring: the string is empty');
         halt
      end;

      for index := 1 to length do s.letters[index] := a[index];
      s.length := length;
      s.current := 1
end; (* fillstring *)
(* end module filler.fillstring version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module filler.filltrigger *)
procedure filltrigger(var t: trigger;
                      a: filler);
(* fill the trigger t *)
begin (* filltrigger *)
         fillstring(t.seek,a)
end; (* fillstring *)
(* end module filler.filltrigger version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module copyaline *)
procedure copyaline(var fin, fout: text);
(* copy a line from file fin to file fout *)
begin (* copyaline *)
      while not eoln(fin) do begin
         fout^ := fin^;
         put(fout);
         get(fin)
      end;
      readln(fin);
      writeln(fout);
end; (* copyaline *)
(* end module copyaline version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module copyline *)
procedure copyline(var fin, fout: text);
(* copy a line from file fin to file fout
but DO NOT CARRIAGE RETURN on the fout.
Carriage return on the fin. *)
begin (* copyline *)
      while not eoln(fin) do begin
         fout^ := fin^;
         put(fout);
         get(fin)
      end;
      readln(fin);
end; (* copyline *)
(* end module copyline version = 5.27; (@ of prgmod.p 2005 Aug 06 *)

(* ********************************************************************** *)

(* begin module genpic.gaushist *)
procedure gaushist(entries: integer;    ave, vari: real;
                  var stanarray: rhistarray);
(* fill the stanarray with values assuming the data fits a
   gaussian distribution.  the equation used is from bevington, p.r.,
   'data reduction and error analysis for the physical sciences', p. 44:

        prob(x) = exp[-1/2((x-ave)/sd)**2]/sd*sqrt(2*pi).

   where prob(x) is the probability of getting the value x.  to determine
   the expected number of values inside a given interval, we calculate
   prob(x) for the mid-point of the interval, multiply by the width of
   the interval and then multiply this total probability by the number of
   entries in the data.     *)
(* modified from version = 1.33;  (@ of genhis, 1985 dec 19 
so that it does REAL values rather than integer ones!!! *)
const pi = 3.14159265; (* used in calculating the curve *)
      Zmax = 10; (* Number of standard deviations above which we
                    just set the gaussian to zero. *)
var   sd,  (* standard deviation *)
      d1,  (* first denominator, = 2*sd**2 *)
      d2,  (* second denominator, = sd*sqrt(2*pi) *)
      x,  (* the position for which the expectation is calculated *)
      ex: real;  (* probability of getting a value in the interval *)
      i: integer;  (* index *)
      Z: real;  (* number of standard deviations from the mean *)
begin
      sd := sqrt(vari);
      d1 := 2 * vari;
      d2 := sd * sqrt(2 * pi);
      with stanarray do
      for i := 0 to (slots - 1) do begin
         x := range[start] + (i + 0.5) * interval;
         (* ex :=  exp(-(x - ave) * (x - ave)/d1) / d2 * interval;
            This formula can't handle really large deviations,
            so break it into parts: *)
         Z := (-(x - ave) * (x - ave)/d1);
         if -Z < Zmax
         then ex := exp(Z) / d2 * interval
         else ex := 0.0;
{
         numbers[i+1] := round(ex * entries);
}
         (* for THIS program, we don't round! *)
         numbers[i+1] := ex * entries;
      end;
end;
(* end module genpic.gaushist *)

(* begin module histogram.poishist *)
procedure poishist(entries: integer;  ave: real;   var stanarray: rhistarray);
(* fill the stanarray with values assuming the data fits a poisson
   distribution.  the probability distribution is defined as:

         prob(x) = ave**x * exp(-ave) / 'x-factorial' .

   note several things:  the variance of a poisson distribution is the same
   as the average;  the poisson distribution is only defined for ave > 0
   and for x >= 0;  the distribution is only really defined for integer x,
   but we can also calculate it for reals.  since for large values of x
   'x-factorial' is hard to calculate we use the following approximation
   based on sterling"s approximation for 'x-factorial':

      ln(prob(x)) = x - ave + x * ln(ave/x) - ln(2*pi*x)/2 .

   for x = 1 this approximation is only off by the factor 1.08, and
   allows us to calculate the prob(x) for all real x > 1.  for x
   between 0 and 1 we use the approximation prob(x) = exp(-ave).
   if ave <= 0 we skip out of the procedure.   *)
const pi = 3.14159265; (* used in calculating the curve *)
var   x,  (* the position for which the expectation is calculated *)
      lnex,  (* the natural log of ex *)
      ex: real;  (* probability of getting a value in the interval around x *)
      i: integer;  (* index *)
begin
      if (ave > 0) then with stanarray do
      for i := 0 to (slots - 1) do begin
            (* get the midpoint of the interval *)
         x := range[start] + (i + 0.5) * interval;
           (* the poisson is not defined for x < 0, so we set the array to 0 *)
         if (x < 0) then ex := 0
            (* for x between 0 and 1 use ex = exp(-ave) *)
         else if (x <= 1) then ex := exp(-ave)
         else begin
            lnex := x - ave + x * ln(ave/x) - ln(2*pi*x)/2;
            ex := exp(lnex) * interval;
         end;
         numbers[i+1] := round(ex * entries)
      end
      else writeln(output,' warning: poisson not defined for ave <= 0',
               ', procedure poishist called but not used');
end;
(* end module histogram.poishist version = 1.33;  (@ of genhis, 1985 dec 19 *)
(* ********************************************************************** *)

(* begin module pic.functions *)
(* ********************************************************************** *)
(* begin module pic.await *)
procedure await;
(* Wait for user to type a carriage return.  the routine assumes that
there is a global file called input. *)
begin
(* the infinite way:
    writeln(output);
    writeln(output,'*********************************');
    writeln(output,'* Use control-c to kill program *');
    writeln(output,'*********************************');
    while true do begin end;*)
end;
(* end module pic.await version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.startpic *)
procedure startpic(var afile:text; setscale,x,y: real; thefont: char);
(* open the graphics field, with the given scale, and at (x,y)
in that scale.  scale is in device coordinates per cm.
The font is chosen with thefont; t = Times-Roman, c = Courier-Bold *)
(* start pic output to file afile, set the globals *)
(* NONSTANDARD *)
(* this is the actual "world" coordinates used: *)
(*                        xmin,  xmax,  ymin, ymax *)
(*    ns; if (setwindow(-5.0/scale, +5.0/scale, -5.0/scale, +5.0/scale)*)
begin
   writeln(afile,'gsave'); (* save the current graphics state *)

{2005 Aug 6: get rid of these finally
   writeln(afile,'% initgraphics'); (* make sure the printer
           is ready to print, without this, sometimes an Apple laserwriter
           will print the graph upside down, tiny and backwards! *)
   writeln(afile,'% clear erasepage'); (* clean residue from before *)
}

   scale := setscale; (* set the global scale *)

   case thefont of
      'c': begin
           writeln(afile,'/Courier-Bold findfont'); (* locate the font *)
           writeln(afile,10:1,' scalefont'); (* set the font size in points*)
      end;
      't': begin
           writeln(afile,'/Times-Roman findfont'); (* locate the font *)
           writeln(afile,12:1,' scalefont'); (* set the font size in points*)
      end;
   end;

   writeln(afile,'setfont'); (* put the font into the current font *)

(* If the following statement is done then it will work on the sun, but will
kill the applewriter!!!!

Sun's non-standard PostScript extension, setlinewidth has default 0,
as stated in the Read This First and the NeWS Manual.
This draws very quickly with 1 bit wide lines.
If '1 setlinequality' is not done, then one cannot set the width of lines.
So to use PostScript on the screen, I must first do
'1 setlinequality'.  However, if I send this code to the Applewriter,
it kills PostScript on the Applewriter and I get no output whatsoever!
(It took me several hours to figure this out, since once PostScript is killed
on the Applewriter, the NEXT output is also smashed and I had to figure that
out also...)

So a standard PostScript program will not work correctly with the
default.  "Correcting" the PostScript program so that it works on the
Sun means that it BOMBS on the Applewriter.

The default for setlinequality should be '1 setlinequality' so that
the same PostScript code can be used both on the Sun and with other devices.
If you want speed, use the nonstandard form.
An alternative is to redefine setlinequality so that '0 setlinequality'
does give correct results with standard PostScript.

Please review this, Randy.  I think that Sun should fix it.
   writeln(afile,'1 setlinequality');  makes lines at least 1 bit wide *)

   (* set the scale to cm
   writeln(afile,
                 scale:picwidth:picdecim,' ',
                 scale:picwidth:picdecim,' scale'); *)

   (* define some things in postscript *)
   (* doline allows less stuff to be put in the output file.
      it takes two numbers off the stack, copies them, draws a line
      to them as coordinates. *)
(* replaced by 'currentpoint translate'
   writeln(afile,'/doline { 2 copy lineto } def');
*)
   (* define a function that makes cm out of a number *)
(* do this all internally here, it's faster
   writeln(afile,'/i { ',scale:picwidth:picdecim,' mul} def');
*)

   (* move to the start point on the page *)
   writeln(afile,
                     (x*scale):picwidth:picdecim,
                 ' ',(y*scale):picwidth:picdecim,
                 ' translate');

    writeln(afile);
    writeln(afile,'% Define functions so the text produced is smaller');
    writeln(afile,'/a {stroke newpath 0 0} def     % special for arc');
    writeln(afile,'/c {stroke 0 0 moveto} def      % current point');
    writeln(afile,'/f {findfont 10 scalefont setfont} def');
    writeln(afile,'   % to set fonts simply use the f function.  Example:');
    writeln(afile,'   %/Symbol f (\142) /Courier-Bold f (-galactosidase');
    writeln(afile,'/l {lineto} def');
    writeln(afile,'/m {moveto} def');
    writeln(afile,'/n {stroke newpath 0 0 moveto} def'); (* new segment *)
    writeln(afile,'/rl {rlineto} def');
    writeln(afile,'/rm {rmoveto} def');
    writeln(afile,'/s {newpath 0 0 moveto} def     % Start path ');
    writeln(afile,'/t {currentpoint translate} def % translate ');
    writeln(afile,'/x {show} def                   % show teXt ');
    writeln(afile);

   (* start out the pathway *)
   inpath := false;
   (* start the number of segments written: *)
   segments := 0;

   (* now for the normal pic stuff: *)
   inpicture := true;
   picxglobal := 0.0;
   picyglobal := 0.0;
   pictolerance := trunc(exp(picwidth*ln(10))+0.5)
(*;writeln(output,'pictolerance = ',pictolerance:picwidth:picdecim);*)
end;
(* end module pic.startpic version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.stoppic *)
procedure stoppic(var afile:text);
(* stop pic output to file afile *)
(* NONSTANDARD *)
begin
    if inpath then begin
       writeln(afile,'stroke');
       inpath := false
    end;

    writeln(afile,'showpage');
    writeln(afile,'grestore'); (* restore the current graphics state
                                  to what it was before the startpic *)

    await;

    inpicture := false;
end;
(* end module pic.stoppic version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.drawr *)
procedure drawr(var afile: text; dx,dy: real; visibility: char;
               spacing: real);
(* make a line to file afile by relative draw of dx,dy with visibility
  i invisible
  - dashed
  . dotted
  l line
with the dashes or dots separated by the spacing given
(this has no effect with invisible and line). *)
(* NONSTANDARD *)
var
   ddx,ddy: real; (* changes in dx and dy for dots and dashes *)
   dr: real; (* the hypotenuse, the distance actually drawn *)
   on: boolean; (* draw linesegment if true *)
   y: real; (* the variable for tracking dots and dashes *)
   r: integer; (* number of times to cycle for dots and dashes *)
   ss: real; (* precalculated value to make things a bit faster *)
   theta: real; (* angle of the line *)
procedure checkseg(var afile: text);
(* NONSTANDARD checks how many segments have been written, if
more than 'buffer', stroke them to the postscript page *)
const buffer = 10;
begin
   if segments >= buffer
   then begin
   (* New segment: writeln(afile,'stroke newpath 0 0 moveto'); *)
      writeln(afile,'n');
      segments := 0
   end
   else segments := segments + 1;
end;
begin (* drawr *)
   if not inpath then begin
      (* starts from current coordinates *)
      (* Start path: writeln(afile,'newpath 0 0 moveto'); *)
      writeln(afile,'s');
      inpath := true
   end
   else checkseg(afile);
(* checks
if not (visibility in ['l','i','.','-'])
then writeln(afile,'%YELLLLLL!!!',visibility,'!');
writeln(afile,'% ',visibility,' line');*)

   (* put these on the stack, they will always be used *)
   write(afile,    (dx*scale):picwidth:picdecim,
               ' ',(dy*scale):picwidth:picdecim);
   case visibility of
  'l','i': begin
              case visibility of
                 'i': write(afile,' m');
                 'l': write(afile,' l');
              end
           end;
  '.','-': begin (* make up our own dots and dashes *)
              writeln(afile); (* move away from the (dx,dy) on the stack *)
              if spacing <= 0.0 then begin
                 writeln(output,'drawr: spacing zero with . or - line');
                 halt
              end;
              if dx = 0.0
              then begin
                 ddx := 0.0; (* avoid division by zero *)
                 ddy := scale*spacing;
                 if dy < 0 then ddy := - ddy; (* this makes sure that
                    we draw lines straight down if that was the request *)
              end
              else begin
                 (* find out the angle of the slope, intentionally
                    lose the sign *)
                 theta := arctan(abs(dy/dx));

                 ddx := scale*spacing*cos(theta);
                 ddy := scale*spacing*sin(theta);

                 (* return the sign to the little buggers *)
                 if dx < 0 then ddx := -ddx;
                 if dy < 0 then ddy := -ddy;
              end;
              y := 0;
              case visibility of
                 '.': ss := scale*dotfactor;
                 '-': on := true;
              end;

              dr := sqrt(dx*dx+dy*dy);
              for r := 1 to round(dr/spacing) do begin
                 case visibility of
                 '-': begin
                         write(afile,    (ddx):picwidth:picdecim,
                                     ' ',(ddy):picwidth:picdecim);
                         if on
                         then writeln(afile,' rl')
                         else writeln(afile,' rm');
                         on := not on
                      end;
                 '.': begin
                         (* put out a dot like in dotr *)
                         write(afile,
                                    +ss:picwidth:picdecim,' 0 rl');
                         write(afile,' ',
                                    -ss:picwidth:picdecim,' 0 rl');
                         write(afile,' ',(ddx):picwidth:picdecim,
                                     ' ',(ddy):picwidth:picdecim);
                         writeln(afile,' rm');
                      end;
                 end
              end;
              (* let's make really sure we got there!! *)
              writeln(afile,' m'); (* pulled from the stack *)
           end;
   end;

   (* an elegant way to make postscript keep a global record is
   to translate the coordinates! *)
   (* writeln(afile,' currentpoint translate'); *)
   writeln(afile,' t');

   picxglobal := picxglobal + dx;
   picyglobal := picyglobal + dy;
end;
(* end module pic.drawr version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.mover *)
procedure mover(var afile: text; dx,dy: real);
(* move relative the amount (dx, dy). *)
begin
   drawr(afile,dx,dy,'i',0.0);
end;
(* end module pic.mover version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.liner *)
procedure liner(var afile: text; dx,dy: real);
(* draw a line the relative amount (dx, dy). *)
begin
   drawr(afile,dx,dy,'l',0.0);
end;
(* end module pic.liner version = 2.76; (@ of dops.p 2007 Aug 30 *)


(* begin module pic.drawa *)
procedure drawa(var afile: text; x,y: real; visibility: char;
               spacing: real);
(* make a line to file afile to absolute coordinate x,y with visibility
  i invisible
  - dashed
  . dotted
  l line
with the dashes or dots separated by the spacing given
(this has no effect with invisible and line). *)
var
   dx, dy: real; (* differences between current and desired
                    locations *)
begin
   dx := x - picxglobal;
   dy := y - picyglobal;

   drawr(afile,dx,dy,visibility,spacing)
end;
(* end module pic.drawa version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.movea *)
procedure movea(var afile: text; x,y: real);
(* move to absolute x and y *)
begin
   drawa(afile,x,y,'i',0.0);
end;
(* end module pic.movea version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.linea *)
procedure linea(var afile: text; x,y: real);
(* draw a line from current position to absolute x and y *)
begin
   drawa(afile,x,y,'l',0.0);
end;
(* end module pic.linea version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.graphstring *)
procedure graphstring(var tofile: text; var s: string; justification: char);
(* graph the string s.  If it is recognized as a quoted string (surrounded
by double quotes), graph it without the quotes and center it.
Otherwise justify it based on the justification character:
'l' left, 'c' centered, 'r' right.
For right and centered justification, the drawing point is the same
as before the string was done.  For left justification it is at the
right of the string to allow more to be added on there.
If not in picture (global variable inpicture), there is no output *)
(* NONSTANDARD: PostScript dependent code.  Since different fonts
have different sized characters, one must rely on the PostScript
to handle the justification of the string. *)
var i: integer; (* index to s, and temporary storage *)
    quoted: boolean; (* true if the string is quoted *)
    skipping: boolean; (* true if skipping leading blanks *)
begin
   if (inpicture and (s.length > 0))
   then with s do begin
      if length > 2
      then if (letters[1]='"') and (letters[length]='"')
           then quoted := true
           else quoted := false
      else quoted := false;

      (* override so quoted strings are always centered *)
      if quoted then justification := 'c';

      (* do the non-standard postscript: *)
      if justification <> 'l' then write(tofile,'gsave ');

      (* do postscript to complete pervious path *)
      (* set current point: writeln(tofile,'stroke 0 0 moveto'); *)
      writeln(tofile,'c');

      if justification = 'c' then begin
         (* when centering, skip leading blanks *)
         if letters[1] = ' ' then skipping := true
                             else skipping := false;
      end
      else skipping := false;

      write(tofile,'('); (* begin postscript literal *)
      if quoted (* take it literally *)
      then for i := 2 to length-1 do write(tofile,letters[i])
      else for i := 1 to length
           do if skipping then begin (* skip leading blanks *)
                 if letters[i] <> ' '
                 then begin
                      skipping := false;
                      write(tofile,letters[i])
                 end
              (* else skip the blank by not writing it *)
              end
              else write(tofile,letters[i]);
      write(tofile,')'); (* end postscript literal *)

      if justification = 'c' (* center the string *)
      then write(tofile,' dup stringwidth pop neg 2 div 0 rmoveto')
      else if justification = 'r' (* rigth justify the string *)
      then write(tofile,' dup stringwidth pop neg 0 rmoveto');

      writeln(tofile,' x'); (* show the literal *)
      inpath := false; (* force new path from here *)

      if justification <> 'l' then write(tofile,'grestore ');
   end
(* There is no output if not in picture
   else begin
      writestring(tofile,s);
      writeln(tofile)
   end
 *)
end;
(* end module pic.graphstring version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.stringinteger *)
procedure stringinteger(number: integer; var name: string;
                        width: integer; leadingzeros: boolean);
(* make the string from the number, start putting characters in
after the current length point. use width characters.
if leadingzeros is true, trail zeros before the number. *)
var
   bigdigit: integer; (* the location of the biggest digit *)
   dig: integer; (* number of digits in the number *)
   place: integer; (* place to write the next digit of the number *)
   sign: integer; (* the sign of the number *)
begin
   with name do begin
      if number < 0
      then begin
         sign := -1;
         length := length + 1; (* provide room for the sign!! *)
         number := -number;
         if leadingzeros then begin
            writeln(output,'WARNING: stringinteger: the sign of a negative',
                           ' number with leading zeros is lost');
         end
      end
      else sign := +1;

      (* log 10 of the number plus 1 is the number of digits in the number.
      On this sun computer ln(1000)/ln(10) is 2.9999, which when
      truncated gives 2, rather than the desired 3.  To avoid this
      kind of problem, 0.1 is added. *)
      if number > 9
      then dig := trunc(ln(number+0.1)/ln(10))+1
      else dig := 1;

      if dig > width then begin
         writeln(output,'stringinteger: number width too small');
         writeln(output,dig:1,' digit number (',number:1,')');
         writeln(output,'does not fit in ',width:1,' characters');
         halt
      end;
      if leadingzeros
      then bigdigit := length + 1 (* no sign if leading zeros *)
      else begin
         bigdigit := length + width - dig + 1;

         if (bigdigit <= length) and (sign < 0) then begin
            writeln(output,'stringinteger: no room for sign');
            halt
         end;
      end;
      if sign < 0 then letters[bigdigit-1] := '-';

      for place := length + width downto bigdigit do begin
         case (number mod 10) of
            0: letters[place] := '0';
            1: letters[place] := '1';
            2: letters[place] := '2';
            3: letters[place] := '3';
            4: letters[place] := '4';
            5: letters[place] := '5';
            6: letters[place] := '6';
            7: letters[place] := '7';
            8: letters[place] := '8';
            9: letters[place] := '9';
         end;
         number := number div 10;
      end;
      length := length + width;
   end
end;
(* end module pic.stringinteger version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.stringreal *)
procedure stringreal(number: real; var name: string;
                     width, decimal: integer);
(* make the string from the real number, start putting characters in
at the start point. use width characters and decimal characters
after the decimal place *)
   (* note that the rounding operation to get the digits below zero
      must be done first.  then the digits above zero can be lopped off.
      this makes 99.99 come out correctly to 100.0 (to 1 decimal place)
      otherwise, 99.99 -> 0.99 -> 1.0 (rounded) -> 10 (print with 1 decimal
      place), and stringinteger won't be happy about that.
    2003 Aug 28.  corrected missing minus sign for -1 < number <= 0.
*)
var
   abovezero: integer; (* the number shifted above the decimal place, to
      'decimal' positions (and rounded) *)
   shift: integer; (* power of ten used to shift a number around
      relative to the decimal point *)
   sign: integer; (* the sign of the number *)
   thedecimal: integer; (* integer version of the decimal part of the number *)
   theupper: integer; (* integer version of the upper part of the number *)
   signspot: integer; (* of the spot the sign will go. *)
begin
   (* sanity check: *)
   if name.length + width > maxstring then begin
      writeln(output,'real number =',number:1,
                     ' would exceed maxstring = ',maxstring:1);
      halt;
   end;
   if number < 0 then sign := -1
                 else sign := +1;

   number := abs(number); (* make positive *)

   (* the amount to shift the number above zero *)
   shift := round(exp(decimal*ln(10))); (* amount to move above zero *)
   abovezero := round(number*shift); (* move above zero, round off *)
   theupper := trunc(abovezero/shift);
   thedecimal := abovezero - shift*theupper;
{
writeln(output,'            stringreal:  number  = ',number:pwid:pdec);
writeln(output,'            stringreal:    sign  = ',sign:pwid);
writeln(output,'            stringreal: theupper = ',theupper:pwid);
}

   (* create the actual real number *)
   (* before decimal point *)
   (* provide a space for the sign in the resulting string: *)

   with name do begin (* put in the decimal point *)
      (* force a space for the sign by making the number negative *)
      signspot := length + 1; (* take note of the spot the sign will go. *)
      stringinteger(sign*theupper,name,width-decimal-1,false);

      (* 2003 Aug 28
         There is a very special case, known as bug1992.
         when the (number > -1) and (number < 0) the upper part
         of the number is zero (theupper = 0) BUT as an integer
         the sign cannot be passed to stringinteger, since
         -0 is of course 0 (usually, or sometimes).
         SO we have to handle that case and put a minus sign
         in 'by hand' here. *)
      if (sign < 1) and (theupper = 0)
         (* if number is tic = -0.000000000000000055511151231257827021181583405
            (a real example!!) then we would get -0.0 on rounding.
            SO round to the number of decimal places.
            The number of decimal places:
                  10^decimal = exp(ln(10^decimal)) = exp(decimal*ln(10))
         *)
         and (round(exp(decimal*ln(10))*number) <> 0)
      then begin
         (* ok, starting at signspot, move to the right until
            we are snug up against the number *)
         while letters[signspot+1]=' ' do signspot := succ(signspot);
         letters[signspot]:='-';
      end;

{
write(output,
   'stringinteger(',sign*theupper:1,',"');
writestring(output, name);
write(output, '",', width-decimal-1:1,',',false);
writeln(output,')');
}

      (* put in the decimal point *)
      length := length + 1;
      letters[length] := '.';
   end;
   stringinteger(thedecimal,name,decimal,true); (* after decimal point *)
end;
(* end module pic.stringreal version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.picnumber *)
procedure picnumber(var afile: text;
                    dx, dy, number: real; width, decimal: integer;
                    justification: char);
(* Supply graphic commands for a 'number' whose center is at the relative point
(dx, dy) from the current point, 'width' characters wide and 'decimal'
characters beyond the decimal point.
If the width is zero, no number is produced.
procedure stringnumber(number: integer; start: integer; var name: string);
the location after the call is the same as before the call.
The string is optionally justified: left, centered or right: lcr. *)
var
   name: string; (* the string to pack the number into for shipping out *)
begin
   if width > 0 then begin
      mover(afile,dx,dy);

      clearstring(name);

      if decimal>0
      then stringreal(number,name,width,decimal)
      else stringinteger(round(number),name,width,false);

      graphstring(afile, name, justification);
      mover(afile,-dx,-dy);
   end
end;
(* end module pic.picnumber version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.xtic *)
procedure xtic(var afile: text; length, dx, dy, number: real;
               width, decimal: integer;
               logxnormal: boolean;
               logxbase: real);
(* produce a tic mark for the x axis of "length" long.
Supply a number whose center is at the relative point (dx, dy)
from the end to the tick, 'width' characters wide and 'decimal'
characters beyond the decimal point.
If the width is zero, no number is produced.
the location after the call is the same as before the call.
If logxnormal is true, then raise the number
to logxbase. *)
begin
   liner(afile,0.0,-length);
   if logxnormal
   then picnumber(afile,dx,dy,exp(number*logxbase),width,decimal,'c')
   else picnumber(afile,dx,dy,number,width,decimal,'c');
   mover(afile,0.0,length);
end;
(* end module pic.xtic version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.ytic *)
procedure ytic(var afile: text; length, dx, dy: real;
               number: real;
               width, decimal: integer;
               logynormal: boolean;
               logybase: real);
(* produce a tic mark for the y axis of "length" long.
Supply a number whose right side is started at the relative point (dx, dy)
from the end to the tick, 'width' characters wide and 'decimal'
characters beyond the decimal point.
If the width is zero, no number is produced.
the location after the call is the same as before the call.
If logynormal is true, then raise the number
to logybase. *)
begin
   liner(afile,-length,0.0);

   (* convert the number if we are doing logynormal: *)
   if logynormal then number := exp(number*logybase);

   picnumber(afile,dx,dy,number,width,decimal,'r');
   mover(afile,length,0.0);
end;
(* end module pic.ytic version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.doaxis *)
procedure doaxis(var afile: text;
         theaxis: char;
         doaxisline: boolean;
         alength,fromtic,interval,totic: real;
         subintervals: real;
         length, dx, dy: real;
         width, decimal: integer;
         logscale, lognormal: boolean;
         logbase: real);
(* draw an axis starting from the current position.
Which axis it is is defined by theaxis, 'x' (horizontal) or 'y' (vertical).
Combining the code for both axes into one procedure is a little
slower, but drawing the axis does note ever take significant time,
and this allows improvements to be made on both axes simultaneously.
The length of the axis is alength.
If doaxisline is true then the axis line is drawn.
The axis is labeled with numbers starting with fromtic
at intervals given up to totic.
The remaining variables describe the form of the tic marks as in ytic.
If the width is zero, no number is produced.
the location after the call is the same as before the call.
If logscale and lognormal is true, then raise the tic numbers to logbase.
 *)
var
   half: real; (* half the jump interval.  By adding this to the while loops,
                  we assure that the very last tic gets done, and isn't lost
                  due to roundoff *)
   jump: real; (* the space to move on the graph between tic marks *)
   jumpdistance: real; (* the total jumps made.  this may not be
      a simple function of the input variables since they may
      not work out to an exact number of jumps *)
   tic: real; (* the numerical value of the tic label *)

   dosubtics: boolean; (* do sub tics *)
   subtic: real; (* the numerical value of the (unlabeled) subtic *)
   subinterval: real; (* the numerical interval between subtics *)
   subjump: real; (* the space to move on the graph between subtic marks *)
   halfsubinterval: real; (* half a subjump, see half *)

   currentspot: real; (* current graphing spot *)
   oldspot: real; (* previous graphing spot *)
   axisscale: real; (* axis scaling factor *)

begin
   writeln(afile,'gsave');

{
writeln(output,'In doaxis');
writeln(output,'interval=',interval:10:4);
writeln(output,'subintervals=',subintervals:10:4);
writeln(output,'logbase=',logbase:10:4);
}

   if theaxis = 'x' then begin
      if doaxisline then begin
         liner(afile,+alength,0.0);
         mover(afile,-alength,0.0);
      end;
   end
   else begin
      if doaxisline then begin
         liner(afile,0.0,+alength);
         mover(afile,0.0,-alength);
      end;
   end;

   if totic = fromtic then begin
      writeln(output,'doaxis: ',theaxis,' axis fromtic and totic',
                     ' cannot be equal');
      halt;
   end;

   if (alength = 0.0) or (interval = 0.0) then begin
      writeln(output,'doaxis: neither ',
                     theaxis,' axis length nor interval can be zero');

      halt;
   end;

   axisscale := alength / (totic - fromtic);
   jump := axisscale * interval;
   jumpdistance := 0;
   half := interval / 2.0;

   if subintervals > 1 then begin
      dosubtics := true;
      subinterval := interval/subintervals;
      halfsubinterval := subinterval / 2.0;
      subjump := jump/subintervals;
   end
   else begin
      dosubtics := false;
      subinterval := 0;
      halfsubinterval := 0;
      subjump := 0;
   end;
{
writeln(output,'fromtic  = ',fromtic:10:4);
writeln(output,'totic    = ',totic:10:4);
writeln(output,'interval = ',interval:10:4);
writeln(output,'half     = ',half:10:4);
}

   tic := fromtic;
   if interval > 0.0 then while tic <= totic+interval do begin
{
writeln(output,'* tic=',tic:10:4);
}
      if tic <= totic then begin
         if theaxis = 'x'
         then xtic(afile,length,dx,dy,tic,width,decimal,lognormal,logbase)
         else ytic(afile,length,dx,dy,tic,width,decimal,lognormal,logbase);
      end;

      (* 2007 Aug 30 the extra interval makes subtics go to the end
         of the graph rather than ending at the last tic mark *)
      if tic <= totic + interval then begin
{
writeln(output,'totic+half + interval=',totic+half + interval:10:4);
writeln(output,'totic+interval=',totic+interval:10:4);
      if tic <= totic+half + 1 then begin
writeln(output,'TIC=',tic:10:4);
writeln(afile,'% tic=',tic:10:4);
mover(afile,0.05,0.0);
}
         if dosubtics then begin (* do subtic marks *)
            if logscale then begin (* do subtic marks on log scale *)
               (* subtic starts as a "normal" number (ie, no log taken) at tic: *)
{
writeln(output,'2^tic=',exp(tic*logbase):10:4);
writeln(output,'2^(tic+interval)=',exp((tic+interval)*logbase):10:4);
}
               subtic := exp(tic*logbase);
               (* subtic will proceed to the same but at tic+interval.
                  We divide that into the subintervals. *)
{
writeln(output,'halfsubinterval=',halfsubinterval:10:4,' original');
}
               subinterval := (exp((tic+interval)*logbase) - subtic)/subintervals;
               halfsubinterval := subinterval/2.0;

{
writeln(output,'subtic=         ',subtic:10:4);
writeln(output,'subinterval=    ',subinterval:10:4);
writeln(output,'halfsubinterval=',halfsubinterval:10:4);
}

               oldspot := axisscale * tic;
               while subtic < exp(logbase*(tic+interval)) - halfsubinterval
               do begin

                  (* although tic is on a log scale,
                     we have to have subtic on the regular scale
                     to alter the positions of the subtics *)

                  (* if subinterval is constant,
                     the following makes linearly spaced marks: *)
                  subtic := subtic + subinterval;

                  (* the actual jumps have to be in the log form: *)
                  currentspot := axisscale*ln(subtic)/logbase;
                  subjump := currentspot - oldspot;
{
writeln(output,'       SUBTIC=',subtic:10:4);
writeln(output,'       ln(SUBTIC)/logbase=',ln(subtic)/logbase:10:4);
writeln(output,'       currentspot=',currentspot:10:4);
writeln(output,'       subjump=',subjump:10:4);
writeln(output,'       oldspot=',oldspot:10:4);
writeln(afile,'% subtic=',subtic:10:4);
}
                  oldspot := currentspot;


                  if theaxis = 'x' then begin
                     xtic(afile,length/2,dx,dy,0,0,0,lognormal,logbase);
                     mover(afile,subjump,0.0);
                  end
                  else begin
                     ytic(afile,length/2,dx,dy,0,0,0,lognormal,logbase);
                     mover(afile,0.0,subjump);
                  end;

                  jumpdistance := jumpdistance + subjump;
               end
            end
            else begin (* do subtic marks on regular scale *)
               subtic := tic;
               while subtic < tic+interval-halfsubinterval do begin
                  subtic := subtic + subinterval;

                  if theaxis = 'x' then begin
                     mover(afile,subjump,0.0);
                     if subtic <= totic
                     then xtic(afile,length/2,dx,dy,0,0,0,lognormal,logbase);
                  end
                  else begin
                     mover(afile,0.0,subjump);
                     if subtic <= totic
                     then ytic(afile,length/2,dx,dy,0,0,0,lognormal,logbase);
                  end;

                  jumpdistance := jumpdistance + subjump;
               end
            end
         end
         else begin (* do regular tic marks *)
            if theaxis = 'x' then mover(afile,jump,0.0)
                             else mover(afile,0.0,jump);
            jumpdistance := jumpdistance + jump
         end
      end;
      tic := tic + interval;
   end
   else if interval < 0.0 then while tic >= totic-half do begin
      if dosubtics then writeln(output,
                        'Sorry, no subtics with negative scales');

      if theaxis = 'x'
      then xtic(afile,length,dx,dy,tic,width,decimal,lognormal,logbase)
      else ytic(afile,length,dx,dy,tic,width,decimal,lognormal,logbase);

      tic := tic + interval;
      if tic >= totic-half then begin
         if theaxis = 'x' then mover(afile,jump,0.0)
                          else mover(afile,0.0,jump);
         jumpdistance := jumpdistance + jump
      end
   end;

   if theaxis = 'x' then mover(afile,-jumpdistance,0.0)
                    else mover(afile,0.0,-jumpdistance);
   writeln(afile,'grestore');
end;
(* end module pic.doaxis version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.xaxis *)
procedure xaxis(var afile: text;
         doaxisline: boolean;  (* line on axis is plotted *)
         axlength,fromtic,interval,totic: real;
         xsubintervals: real;
         length, dx, dy: real;
         width, decimal: integer;
         logxscale, logxnormal: boolean;
         logxbase: real);
(* draw an x axis starting from the current position. *)
begin
   doaxis(afile,
         'x',
         doaxisline,
         axlength,fromtic,interval,totic,
         xsubintervals,
         length, dx, dy,
         width, decimal,
         logxscale, logxnormal,
         logxbase)
end;
(* end module pic.xaxis version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.yaxis *)
procedure yaxis(var afile: text;
         doaxisline: boolean;  (* line on axis is plotted *)
         aylength,fromtic,interval,totic: real;
         ysubintervals: real;
         length, dx, dy: real;
         width, decimal: integer;
         logyscale, logynormal: boolean;
         logybase: real);
(* draw an y axis starting from the current position. *)
begin
   doaxis(afile,
         'y',
         doaxisline,
         aylength,fromtic,interval,totic,
         ysubintervals,
         length, dx, dy,
         width, decimal,
         logyscale, logynormal,
         logybase)
end;
(* end module pic.yaxis version = 2.76; (@ of dops.p 2007 Aug 30 *)
(* ********************************************************************** *)
(* end module pic.functions version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module pic.boxr *)
procedure boxr(var afile: text; width, height: real);
(* make a box to file afile with width in the x direction
and height in the y direction as given.
the box goes toward the positive x and y directions.
the box is relative to the current position, so it
returns to original position afterwards *)
begin
   liner(afile,0.0,height);
   liner(afile,width,0.0);
   liner(afile,0.0,-height);
   liner(afile,-width,0.0)
end;
(* end module pic.boxr version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module interact.getstring *)
procedure getstring(var afile: text; var buffer: string;
                    var gotten: boolean);
(* get a line (as a string) from a file not using string calls.  this lets
one obtain lines from a file without interactive prompts *)
var   index: integer; (* of buffer *)
begin (* getstring *)
      clearstring(buffer);
      if eof(afile)
      then gotten := false
      else begin
         index := 0;
         while (not eoln(afile)) and (index < maxstring) do begin
            index := succ(index);
            read(afile, buffer.letters[index])
         end;
         if not eoln(afile) then begin
            writeln(output, ' getstring: a line exceeds maximum string size (',
                            maxstring:1,')');
            halt
         end;
         buffer.length := index;
         buffer.current := 1;
         readln(afile);
         gotten := true
      end
end; (* getstring *)
(* end module interact.getstring version = 5.27; (@ of prgmod.p 2005 Aug 06 *)

(* begin module skipblanks *)

(* 2003 July 31: tab is considered a blank character *)

function isblank(c: char): boolean;
(* is the character c blank or tab? *)
const
   tab = 9; (* tab character *)
begin
   isblank := (c = ' ') or (ord(c) = tab)
end;

procedure skipblanks(var thefile: text);
(* skip over blanks until a non-blank, or end of line, is found *)
begin
   while isblank(thefile^) and not eoln(thefile) do get(thefile);
end;

procedure skipnonblanks(var thefile: text);
(* skip over nonblanks until a blank, or end of line, is found *)
begin
   while (not isblank(thefile^)) and not eoln(thefile) do get(thefile);
end;

procedure skipcolumn(var thefile: text);
(* skip over a data column *)
begin
   skipblanks(thefile); skipnonblanks(thefile)
end;
(* end module skipblanks version = 2.76; (@ of dops.p 2007 Aug 30 *)

(* begin module checknumber *)
function checknumber(var afile: text): boolean;
(* check that there is a number next in the file.  If not, return
false.   This is useful for protection when reading a parameter file. *)
var ok: boolean; (* result of this check *)
procedure conclude;
begin
   writeln(output,'Including this character, the rest of the data line is:');
   copyaline(afile,output);
   ok := false;
end;
begin
   ok := true; (* be optimistic *)
   if eof(afile)
   then begin
      ok := false;
      write  (output,'A number was expected on a data line, but');
      writeln(output,' the end of the file was found instead.');
   end
   else begin
      skipblanks(afile);
      if eoln(afile) then begin
         write  (output,'A number was expected on a data line, but');
         writeln(output,' the end of the line was found instead.');
         conclude;
      end;
      if not (afile^ in
         ['0','1','2','3','4','5','6','7','8','9','.','-','+']) then begin
         write  (output,'A number was expected on a data line, but');
         writeln(output,' the character "',afile^,'" was found instead.');
         conclude;
      end;
   end;
   checknumber := ok
end;
(* end module checknumber version = 5.27; (@ of prgmod.p 2005 Aug 06 *)

(* ********************************************************************** *)

(* begin module genpic.getdata *)
procedure getdata(var histog: text; var data: histdata);
(* scan into histog to find the y scale *)
var
      ch: char; (* used to skip asterisks *)
      done: boolean; (* true when no more comment lines are found *)
      s: trigger; (* the search string where the parameters start *)
procedure t;
(* test that there is something to read *)
begin
      if eof(histog) then begin
         writeln(output,'missing lines of histog');
         halt
      end
end;
begin
      reset(histog);
(*                             1         2         3         4         5 *)
(*                    12345678901234567890123456789012345678901234567890 *)
      filltrigger(s, 'parameters:                                       ');
      resettrigger(s);
      (* skip lines until we find one that begins with '* pa' *)
      done := false;
      while not done do begin
         if eof(histog) then t;
         testfortrigger(histog^,s);
         if eoln(histog) then readln(histog)
                         else get(histog);
         if s.found then done := true;
      end;

      readln(histog);

      with data do begin (* read in all the data *)
         t; readln(histog, ch, column);
         t; readln(histog, ch, entries);
         t; readln(histog, ch, minimum);
         t; readln(histog, ch, maximum);
         t; readln(histog, ch, mean);
         t; readln(histog, ch, stdev);
         t; readln(histog, ch, sem);
         t; readln(histog, ch, variance);
         t; readln(histog, ch, uncertainty);
         t; readln(histog, ch, computeduncertainty);
         t; readln(histog); (* a blank line *)
         t; read(histog, ch, start);
            skipblanks(histog);
            skipnonblanks(histog); (* the word 'to' *)
         t; readln(histog, ch, stop);
         t; readln(histog, ch, xinterval);
         t; readln(histog, ch, slots);
         t; readln(histog, ch, ymaximum);
         t; readln(histog, ch, yaxisscale);
         t; readln(histog); (* a blank line *)
         t; readln(histog, ch, ch, plot);
      end
end;
(* end module genpic.getdata *)

(* begin module genpic.putdata *)
procedure putdata(var f: text; var data: histdata);
(* write the data to file f *)
begin

   with data do begin (* write out all the data *)
      writeln(f, '% ',column:10,' column');
      writeln(f, '% ',entries:10,' entries');
      writeln(f, '% ',minimum:10:5,' minimum');
      writeln(f, '% ',maximum:10:5,' maximum');
      writeln(f, '% ',mean:10:5,' mean');
      writeln(f, '% ',stdev:10:5,' st dev');
      writeln(f, '% ',sem:10:5,' SEM');
      writeln(f, '% ',variance:10:5,' variance');
      writeln(f, '% ',uncertainty:10:5,' uncertainty');
      writeln(f, '% ',computeduncertainty:10:5,' computeduncertainty');
      writeln(f); (* a blank line *)
      writeln(f, '% ',start:10:5,' start');
      writeln(f, '% ',stop:10:5,' stop');
      writeln(f, '% ',xinterval:10:5,' x interval');
      writeln(f, '% ',slots:10,' slots');
      writeln(f, '% ',ymaximum:10,' y maximum');
      writeln(f, '% ',yaxisscale:10:5,' y axis scale');
      writeln(f); (* a blank line *)
      writeln(f, '% ',plot,plot,' plot');

(*
         column: integer;
         entries: integer;
         minimum: real;
         maximum: real;
         mean: real;
         stdev: real;
         variance: real;
         uncertainty: real;
         computeduncertainty: real;
         start: real;
         stop: real;
         xinterval: real;
         slots: integer;
         ymaximum: integer;
         yaxisscale: real;
         plot: char
*)
   end
end;
(* end module genpic.putdata *)

(* begin module xyplo.comment *)
procedure comment(var f: text);
(* put a PostScript comment start out to file f *)
begin write(f,'% ') end;
(* end module xyplo.comment *)

(* begin module genpic.copystart *)
procedure copystart(var histog, picout: text; boxwidth: real;
                    var downshift: real);
(* copy the header lines from histog to picout.  boxwidth is the
height to move down for each line.  Downshift is the total amount
of moving down that was done (it's the number of lines time boxwidth). *)
var
   done: boolean; (* true when the end of the histog header is found *)
   gotten: boolean; (* a line was obtained *)
   line: string; (* a line of text *)
   lines: integer; (* number of lines done *)
   t: trigger; (* a trigger to find the beginning of the data *)
begin
      reset(histog);
(*                             1         2         3         4         5 *)
(*                    12345678901234567890123456789012345678901234567890 *)
      filltrigger(t, 'beginning     value                               ');
      resettrigger(t);

   done := false;
   gotten := true;

   if parameterversion <= bugversion226
   then lines := 4
   else lines := 0;

   mover(picout,0.0,-lines*boxwidth); (* move from top of page *)

   while gotten and (not done) do begin
      getstring(histog,line,gotten);
      if gotten then begin

(* debug line:
writestring(output,line);writeln(output); *)

(* 2003 Aug 21, version 2.30:
Why are we doing the following mover????????
This is now removed if the version number is more recent.
It is a nasty bug because all parameter files depended on this.
It is a holdover from some time (perhaps) when the comment
lines were printed on the output.  Since we don't do that anymore,
it is not needed.
zzz
*)
         if parameterversion <= bugversion226
         then mover(picout,0.0,-boxwidth); (* and move down *)

         while (line.current <= line.length) and not done do begin
            testfortrigger(line.letters[line.current],t);
            if t.found then done := true;
            line.current := line.current + 1
         end;
         lines := lines + 1;
      end
   end;
   if parameterversion <= bugversion226
   then downshift := lines * boxwidth
   else downshift := 0     * boxwidth;

{zzz
   writeln(output,'at compute: lines: ',lines:8);
   writeln(output,'at compute: * boxwidth:  ',boxwidth:8:2);
   writeln(output,'at compute: = downshift: ',downshift:8:2);
}

   (* skip the blank line *)
   if not eof(histog)
   then readln(histog)
   else begin
      writeln(output,'missing data in histog file');
      halt
   end
end;
(* end module genpic.copystart *)

(* begin module genpic.readvalue *)
procedure readvalue(var histog: text; var b, v: real);
(* read the interval begin (b) and histogram value (v)
from histog *)
begin
      readln(histog,b,v)
end;
(* end module genpic.readvalue *)

(* begin module copyfile *)
procedure copyfile(var fin, fout: text);
(* copy the rest of file fin to fout *)
begin
   while not eof(fin) do copyaline(fin, fout);
end;
(* end module copyfile version = 5.27; (@ of prgmod.p 2005 Aug 06 *)

(* begin module genpic.upgradeto226 *)
procedure upgradeto226(var genpicp: text);
(* upgrade the genpicp file to version 2.26:
allow control of all bounding box edges with pageedges etc. on new line 19.
n 0 0 0 0   edgecontrol (p=page), edgeleft, edgeright, edgelow, edgehigh in cm
*)
const
   copylines = 14; (* the line number of copied lines *)
var
   internal: text; (* a place to hold the old genpicp *)
   titlesize: text; (* a place to hold the new parameter line *)
   line: integer; (* a line to be worked with *)
   parameterversion: real; (* parameter version number *)
begin
   parameterversion := 2.26;
   writeln(output, 'upgrading to version ',parameterversion:4:2,' ...');
(*
Read through and insert a new parameter for the second title size:
COPY
2.20  version of genpicp that this parameter file is designed for.
1.0   x cm
10.0  y cm
0     rotation
4     graphheight, height of the graph, cm
0.3   boxwidth, width of the histogram boxes, cm
0.6   intervalsize, space for interval number, cm
0.6   histogramvalue, space for histogram value, cm
0     boxshift, shift boxes up relative to numbers, cm
5     field: number of characters devoted to the interval
1     decimal: number of characters devoted to the interval's decimal places
5     field: number of characters devoted to the number of numbers
1     modulo: multiples of this number are shown
0     barlocation: where to put a vertical bar
   COPY TO HERE (ie lines 2 to 14 since the first line is already read)
   CAPTURE THIS SEPARATELY:
12    column name size (points)
   COPY THREE LINES (16 to 18):
0     relative column 1 name x coordinate adjustment (cm)
0.20  relative column 1 name y coordinate adjustment (cm)
Rsequence (bits)
   INSERT THE CAPTURED LINE HERE
   THEN COPY TO END
0     relative column 2 name x coordinate adjustment (cm)
0.40  relative column 2 name y coordinate adjustment (cm)
number
14    title name size (points)
-5.2  relative title x coordinate adjustment (cm)
0.0   relative title y coordinate adjustment (cm)
Final Rsequence at generation 2000
1     How many more titles to do
12    other title name size (points)
0.0   relative title x coordinate adjustment (cm)
-0.8  relative title y coordinate adjustment (cm)
using 100 seeds ranging from 0.00 to 0.99
*)

   (* copy parameter file to internal *)
   reset(genpicp);
   readln(genpicp); (* skip old parameter version line *)
   rewrite(internal);
   for line := 2 to copylines
   do copyaline(genpicp, internal);

   (* capture the main titlesize *)
   rewrite(titlesize);
   copyaline(genpicp, titlesize);
   (* put the titlesize into internal *)
   reset(titlesize);
   copyaline(titlesize, internal);

   (* copy the three title1 lines: *)
   for line := 16 to 18
   do copyaline(genpicp, internal);

   (* put the titlesize into internal NEW PARAMETER *)
   reset(titlesize);
   copyaline(titlesize, internal);

   (* finish the copy of parameter file to internal *)
   copyfile(genpicp, internal);

   (* write the NEW PARAMETER LINE *)
   writeln(internal,
           'n 0 0 0 0   edgecontrol (p=page),',
           ' edgeleft, edgeright, edgelow, edgehigh in cm');

   (* copy internal to parameter file *)
   reset(internal);
   rewrite(genpicp);
   writeln(genpicp,parameterversion:4:2,'  version of',
         ' genpicp that this parameter file is designed for.');
   copyfile(internal, genpicp);

   (* add the new material at the end: *)
   (* none to add *)

   reset(genpicp); (* ready to start reading again *)
 
end;
(* end module genpic.upgradeto226 *)

(* begin module genpic.upgradeto250 *)
procedure upgradeto250(var genpicp: text);
(* upgrade the genpicp file to version 2.50:
y axis controls
*)
const
   copylines = 14; (* the line number of copied lines - before titles *)
var
   internal: text; (* a place to hold the old genpicp *)
   titlesize: text; (* a place to hold the new parameter line *)
   line: integer; (* a line to be worked with *)
   parameterversion: real; (* parameter version number *)
begin
   parameterversion := 2.50;
   writeln(output, 'upgrading to version ',parameterversion:4:2,' ...');
(*
Read through and insert a new parameter for the second title size:
COPY
2.20  version of genpicp that this parameter file is designed for.
1.0   x cm
10.0  y cm
0     rotation
4     graphheight, height of the graph, cm
0.3   boxwidth, width of the histogram boxes, cm
0.6   intervalsize, space for interval number, cm
0.6   histogramvalue, space for histogram value, cm
0     boxshift, shift boxes up relative to numbers, cm
5     field: number of characters devoted to the interval
1     decimal: number of characters devoted to the interval's decimal places
5     field: number of characters devoted to the number of numbers
1     modulo: multiples of this number are shown
0     barlocation: where to put a vertical bar
   COPY TO HERE (ie lines 2 to 14 since the first line is already read)
   CAPTURE THIS SEPARATELY:
12    column name size (points)
   COPY THREE LINES (16 to 18):
0     relative column 1 name x coordinate adjustment (cm)
0.20  relative column 1 name y coordinate adjustment (cm)
Rsequence (bits)
   INSERT THE CAPTURED LINE HERE
   THEN COPY TO END
0     relative column 2 name x coordinate adjustment (cm)
0.40  relative column 2 name y coordinate adjustment (cm)
number
14    title name size (points)
-5.2  relative title x coordinate adjustment (cm)
0.0   relative title y coordinate adjustment (cm)
Final Rsequence at generation 2000
1     How many more titles to do
12    other title name size (points)
0.0   relative title x coordinate adjustment (cm)
-0.8  relative title y coordinate adjustment (cm)
using 100 seeds ranging from 0.00 to 0.99
*)

   (* copy parameter file to internal *)
   reset(genpicp);
   readln(genpicp); (* skip old parameter version line *)
   rewrite(internal);
   for line := 2 to copylines
   do copyaline(genpicp, internal);

   (* capture the main titlesize *)
   rewrite(titlesize);
   copyaline(genpicp, titlesize);
   (* put the titlesize into internal *)
   reset(titlesize);
   copyaline(titlesize, internal);

   (* copy the three title1 lines: *)
   for line := 16 to 18
   do copyaline(genpicp, internal);

   (* finish the copy of parameter file to internal *)
   copyfile(genpicp, internal);

   (* write the NEW PARAMETER LINES *)
   writeln(internal,
'x 17 5 5 0.1 -0.00 -0.35 xaxis: control max int subint ticlength ticdx ticdy'
);
   writeln(internal,
'y 15 5 5 0.1 -0.12 -0.12 yaxis: control max int subint ticlength ticdx ticdy'
);

   (* copy internal to parameter file *)
   reset(internal);
   rewrite(genpicp);
   writeln(genpicp,parameterversion:4:2,'  version of',
         ' genpicp that this parameter file is designed for.');
   copyfile(internal, genpicp);

   (* add the new material at the end: *)
   (* none to add *)

   reset(genpicp); (* ready to start reading again *)
 
end;
(* end module genpic.upgradeto250 *)

(* begin module genpic.writetitle *)
procedure writetitle(var afile: text; t: titleptr);
(* write title information to file afile *)
begin
   if t <> nil then with t^ do begin
      writeln(afile, '% ', titlenamesize:1, ' size in points');
      writeln(afile, '% ', titlex:difield:didecimal, ' relative x adjustment');
      writeln(afile, '% ', titley:difield:didecimal, ' relative y adjustment');
      write(afile, '% "');
      writestring(afile, letters);
      writeln(afile, '"');
   end;
end;
(* end module genpic.writetitle *)

(* begin module genpic.readtitle *)
procedure readtitle(var genpicp: text; var t: titleptr);
(* read title information from file genpicp *)
var
   gotten: boolean; (* a line was gotten from genpicp *)
begin
   with t^ do begin
      readln(genpicp, titlenamesize);
      readln(genpicp, titlex);
      readln(genpicp, titley);
      getstring(genpicp, letters, gotten);
      if not gotten then begin
         writeln(output, 'could not find title while reading genpicp');
         halt
      end;
   end;
{
writeln(output);
writetitle(output, t);
}
end;
(* end module genpic.readtitle *)

(* begin module genpic.readparam *)
procedure readparam(var afile: text;
          var x,y,rotation: real;
          var graphheight,boxwidth,intervalsize,histogramvalue,boxshift: real;
          var ifield, idecimal, nfield, modulo: integer;
          var modulomultiplier: real;
          var barlocation: integer;
          var title1, title2, title3: titleptr; (* the main three titles *)
          var othertitles: integer; (* number of other titles *)
          var titles: titleptr; (* the other titles *)
          var edgecontrol: char; (* if 'p' then use page instead of edges *)
          var edgeleft, edgeright, edgelow, edgehigh: real;
              (* added edges around the graph in cm *)

          (* x axis controls: *)
          var xaxiscontrol: char; (* x = plot x axis *)
          var xaxismax, xaxisintervals,
              xaxissubintervals: integer; (* maximum, intervals,
                                         sub-intervals for x axis *)
          var xaxisticlength, xaxisticdx, xaxisticdy: real;

          (* y axis controls: *)
          var yaxiscontrol: char; (* y = plot y axis *)
          var yaxismax, yaxisintervals,
              yaxissubintervals: integer; (* maximum, intervals,
                                         sub-intervals for y axis *)
          var yaxisticlength, yaxisticdx, yaxisticdy: real;

          var dobugreport: boolean); (* whether to tell the user how to
                                        fix the 2.26 bug *)
(* read the parameters as described in the manual *)
var
   checkout: boolean; (* if true, all variable values are ok *)
{
   parameterversion: real; (* parameter version number *)
}
   paramnumber: integer; (* the number of the parameter about to be read *)
   o: integer; (* index to othertitles *)
   t: titleptr; (* pointer to titles *)
procedure cn;
(* short version of call to check number *)
begin
  checkout := checknumber(afile);
  if not checkout then halt; (* avoid snowballing *)
end;
procedure bomb;
(* what to do if a parameter is missing *)
begin
   paramnumber := paramnumber + 1;
   if eof(afile) then begin
      writeln(output,'genpic: readparam: missing parameter number',
              paramnumber:1);
      halt
   end;
end;
begin
   reset(afile);

   dobugreport := false;

   if eof(afile) then begin
      x := dx;
      y := dy;
      rotation := drotation;
      graphheight := dgraphheight;
      boxwidth := dboxwidth;
      intervalsize := dintervalsize;
      histogramvalue := dhistogramvalue;
      boxshift := dboxshift;
      ifield := difield;
      idecimal := didecimal;
      nfield := dnfield;
      modulo := dmodulo;
      modulomultiplier := dmodulomultiplier;
      barlocation := 0;
   end
   else begin
      readln(afile, parameterversion);
      if (round(100*parameterversion) < round(100*updateversion))
      then begin
         writeln(output, 'You have an old parameter file!');
         writeln(output, 'parameterversion is ', parameterversion:4:2);
         writeln(output, '   updateversion is ', updateversion:4:2);

         if (round(100*parameterversion) < round(100*2.26))
         then upgradeto226(genpicp)
         else reset(afile);

         if (round(100*parameterversion) <= round(100*bugversion226))
         then begin

            writeln(output,'******************************************');
            writeln(output,'*********** WARNING **********************');
            writeln(output,'******************************************');
            writeln(output,'* You have an old parameter file, with a *');
            writeln(output,'* version <= 2.26, that has a bug in it. *');
            writeln(output,'* To fix the bug,                        *');
            writeln(output,'* update the version number to:          *');
            writeln(output,'*      2.32                              *');
            writeln(output,'* Then you will find that your graph     *');
            writeln(output,'* shifts to the left (negative x value). *');
            writeln(output,'* Correct this by hand.                  *');
(*
            writeln(output,'* zzz                                    *');
*)
            writeln(output,'******************************************');

            dobugreport := true;

         end;

         if (round(100*parameterversion) < round(100*2.50))
         then upgradeto250(genpicp)
         else reset(afile);

         readln(afile, parameterversion);
      end;

      paramnumber := 1;

      bomb; readln(afile,x);
      bomb; readln(afile,y);
      bomb; readln(afile,rotation);
      bomb; readln(afile,graphheight);
      bomb; readln(afile,boxwidth);
      bomb; readln(afile,intervalsize);
      bomb; readln(afile,histogramvalue);
      bomb; readln(afile,boxshift);
      bomb; readln(afile,ifield);
      bomb; readln(afile,idecimal);
      bomb; readln(afile,nfield);

      bomb;
{
      readln(afile,modulo);
}
      read(afile,modulo);
      skipblanks(afile);
      if not eoln(afile) then begin
         if afile^ in ['0','1','2','3','4','5','6','7','8','9']
         then read(afile,modulomultiplier)
         else modulomultiplier := dmodulomultiplier; (* default value *)
      end
      else begin
         modulomultiplier := dmodulomultiplier; (* default value *)
      end;
      readln(afile); (* skip the reset of the line *)
{
writeln(output,'modulomultiplier = ', modulomultiplier:2);
}

      bomb; readln(afile,barlocation);

      new(title1);
      readtitle(genpicp, title1); title1^.next := nil;
      new(title2);
      readtitle(genpicp, title2); title2^.next := nil;
      new(title3);
      readtitle(genpicp, title3); title3^.next := nil;

      (* read in additional titles *)
      readln(genpicp, othertitles);
      writeln(output, 'reading in ', othertitles:1, ' other titles');

      if othertitles > 0 then begin
         new(titles);
         t := titles;
         for o := 1 to othertitles do begin
             if eof(afile) then begin
                writeln(output,'found end of genpicp when reading in titles');
                halt;
             end;
             if o > 1 then begin
                new(t^.next);
                t := t^.next;
                t^.next := nil;
             end;
             readtitle(genpicp, t);
         end;
      end
      else begin
         titles := nil;
      end;

      read(genpicp, edgecontrol);
      bomb; cn; read(genpicp, edgeleft);
      bomb; cn; read(genpicp, edgeright);
      bomb; cn; read(genpicp, edgelow);
      bomb; cn; read(genpicp, edgehigh);
      readln(genpicp);

      read(genpicp, xaxiscontrol);
      bomb; cn; read(genpicp, xaxismax);
      bomb; cn; read(genpicp, xaxisintervals);
      bomb; cn; read(genpicp, xaxissubintervals);
      bomb; cn; read(genpicp, xaxisticlength);
      bomb; cn; read(genpicp, xaxisticdx);
      bomb; cn; read(genpicp, xaxisticdy);
      readln(genpicp);

      read(genpicp, yaxiscontrol);
      bomb; cn; read(genpicp, yaxismax);
      bomb; cn; read(genpicp, yaxisintervals);
      bomb; cn; read(genpicp, yaxissubintervals);
      bomb; cn; read(genpicp, yaxisticlength);
      bomb; cn; read(genpicp, yaxisticdx);
      bomb; cn; read(genpicp, yaxisticdy);
      readln(genpicp);

      if yaxismax <= 0 then begin
         writeln(output,'yaxismax must be positive');
         halt;
      end;

   end;
end;
(* end module genpic.readparam *)

(* begin module genpic.writeparam *)
procedure writeparam(var afile: text; fc: char;
          x,y,rotation: real;
          graphheight,boxwidth,intervalsize,histogramvalue,boxshift: real;
          ifield, idecimal, nfield, modulo: integer;
          modulomultiplier: real;
          barlocation: integer;
          title1, title2, title3: titleptr; (* the main titles *)
          othertitles: integer; (* number of other titles *)
          titles: titleptr; (* the other titles *)
          edgecontrol: char; (* if 'p' then use page instead of edges *)
          edgeleft, edgeright, edgelow, edgehigh: real; (* edges around *)

          xaxiscontrol: char; (* x = plot x axis *)
          xaxismax, xaxisintervals, xaxissubintervals: integer;
             (* maximum and intervals for x axis *)
          var xaxisticlength, xaxisticdx, xaxisticdy: real; (* x axis
                tic controls: length and positioning of the tic mark *)

          yaxiscontrol: char; (* y = plot y axis *)
          yaxismax, yaxisintervals, yaxissubintervals: integer;
             (* maximum and intervals for y axis *)
          var yaxisticlength, yaxisticdx, yaxisticdy: real); (* y axis
                tic controls: length and positioning of the tic mark *)

(* write the parameters.  If fc - first character - is '%' the parameters can
be used for the postscript output. *)
var
   o: integer; (* index to othertitles *)
   t: titleptr; (* pointer to titles *)
begin
   writeln(afile,fc,' the parameters used are:');
   writeln(afile,fc, x:10:5, ' x');
   writeln(afile,fc, y:10:5, ' y');
   writeln(afile,fc, rotation:10:5, ' rotation');
   writeln(afile,fc, graphheight:10:5, ' graphheight');
   writeln(afile,fc, boxwidth:10:5, ' boxwidth');
   writeln(afile,fc, intervalsize:10:5, ' interval size');
   writeln(afile,fc, histogramvalue:10:5, ' histogram value');
   writeln(afile,fc, boxshift:10:5, ' box shift');
   writeln(afile,fc, ifield:5, ' field width of interval numbers');
   writeln(afile,fc, idecimal:5, ' decimals of interval numbers');
   writeln(afile,fc, nfield:5, ' field width of number data column');
   write  (afile,fc, modulo:5,' ', modulomultiplier:5:1,
                               ' numbers modulo this are plotted',
                               ' and multiplier');
   writeln(afile);
   writeln(afile,fc, barlocation:5,' barlocation: where to put a vertical bar');
   writeln(afile,fc, othertitles:5,' number of other titles');

   (* write out the other titles *)
   writetitle(afile,title1);
   writetitle(afile,title2);
   writetitle(afile,title3);

   t := titles;
   for o := 1 to othertitles do begin
      writetitle(afile, t);
      t := t^.next;
   end;

   writeln(afile,fc,
      ' ',edgecontrol,
      ' ',edgeleft:1:3,' ', edgeright:1:3,' ', edgelow:1:3, ' ',edgehigh:1:3,
      ' edgecontrol (p=page), edgeleft, edgeright, edgelow, edgehigh in cm');

   writeln(afile,fc,
      ' ',xaxiscontrol,
      ' ',xaxismax:1,
      ' ',xaxisintervals:1,
      ' ',xaxissubintervals:1,
        ' xaxiscontrol (x=axis), xaxismax, xaxisintervals');

   writeln(afile,fc,
      ' ',yaxiscontrol,
      ' ',yaxismax:1,
      ' ',yaxisintervals:1,
      ' ',yaxissubintervals:1,
        ' yaxiscontrol (y=axis), yaxismax, yaxisintervals');

end;
(* end module genpic.writeparam *)

(* begin module genpic.buildpic *)
procedure buildpic(hdata: histdata; var histog, picout: text;
          graphheight, boxwidth,intervalsize,histogramvalue,boxshift: real;
          ifield, idecimal, nfield, modulo: integer;
          modulomultiplier: real;
          barlocation: integer;
          downshift: real;
          title1: titleptr; (* the first title *)
          title2: titleptr; (* the second title *)
          title3: titleptr; (* the third title *)
          othertitles: integer; (* the number of other titles *)
          titles: titleptr; (* the other titles *)
          xaxiscontrol: char;
          yaxiscontrol: char);
(* construct the picture of histog into picout
use ymaximum to adjust the size of the plot *)
var
   b: real; (* the interval beginning *)
   halfsmallbox: real; (* half of the size of a small box *)
   index: integer; (* an index for plotting the standard curve *)
   o: integer; (* index to other titles *)
   returnx: real; (* how far to move back on x axis
      to get to the next line *)
   returny: real; (* how far to move back on y axis
      to get to the next line *)
   scale: real; (* a factor to convert between numbers and graphical
      distances in cm *)
   smallbox: real; (* size of small boxes to plot *)
   stanarray: rhistarray; (* an array to store the standard curve in *)

   v: real; (* the histogram value *)
   scalev: real; (* scale * v, the height of the box in points *)
   shiftup: real; (* how much to move the bottom of the vertical
      bar up to avoid touching the prediction curve *)
   t: titleptr; (* pointer into other titles *)
procedure dosmallbox;
(* make a small box at the current position *)
begin
   mover(picout, -halfsmallbox,-halfsmallbox);
   boxr(picout, smallbox, smallbox);
   mover(picout, halfsmallbox,halfsmallbox);
end;
begin

      (* compute the plot *)
      if hdata.plot <> 'n' then begin
         (* set up the stanarray *)
         stanarray.range[start] := hdata.start;
         stanarray.range[stop] := hdata.stop;
         stanarray.interval := hdata.xinterval;
         stanarray.slots := hdata.slots;
         (* calculate the curve *)
         if hdata.plot = 'g'
         then gaushist(hdata.entries,hdata.mean,hdata.variance,stanarray)
         else if hdata.plot = 'p'
         then poishist(hdata.entries,hdata.mean,stanarray)
         else begin
            writeln(output,'pic: build: unknown plot type ,',hdata.plot);
            halt
         end;
      end;

      returnx:=-intervalsize-histogramvalue;
      returny:= -boxwidth-boxshift;
      scale := graphheight/hdata.ymaximum;
      smallbox := boxwidth/4;
      halfsmallbox := smallbox/2;

      index := 0;
{
writeln(output, ' modulomultiplier=',
                  modulomultiplier:2);
}
      while not eof(histog) do begin (* generate the histogram *)
         readvalue(histog,b,v);
         index := succ(index);

         (* turn off normal axis if the xaxis control is on *)
         if (xaxiscontrol <> 'x') then begin
            (* the spacings for b and v come from genhis *)
            if (round(modulomultiplier*b) mod modulo) = 0
            then picnumber(picout,0.0,0.0,b,ifield,idecimal,'r');
{
write  (output, 'b=',b:5:1);
write  (output, ' round(modulomultiplier*b)=',
                  round(modulomultiplier*b):2);
write  (output, ' (round(modulomultiplier*b) mod modulo)=',
                  (round(modulomultiplier*b) mod modulo):2);
writeln(output);
}

            mover(picout,intervalsize,0.0);
            if (round(modulomultiplier*b) mod modulo) = 0
            then picnumber(picout,0.0,0.0,round(v),nfield,0,'r');
         end
         else begin
            mover(picout,intervalsize,0.0);
         end;

         mover(picout,histogramvalue,boxshift);

         scalev := scale * v;

         if b = barlocation then begin
            (* vertical bar *)
            if hdata.plot <> 'n' then begin
               if stanarray.numbers[index] > v
               then shiftup := scale*stanarray.numbers[index]
               else shiftup := scalev
{
;if stanarray.numbers[index] > v
then writeln(output,'> using stanarray',stanarray.numbers[index]:10:5)
else writeln(output,'<= using box',v:10:5)
}
            end
            else shiftup := scalev;
            shiftup := shiftup + 4*smallbox;
            mover(picout, +shiftup,  +boxwidth/2);
            liner(picout, +graphheight -shiftup, 0);
            mover(picout, -graphheight +shiftup, 0); (* undo liner *)
            mover(picout, -shiftup,  -boxwidth/2);

{ old box method:
            mover(picout,+shiftup,+boxwidth/2);
            boxr(picout, graphheight - shiftup, halfsmallbox);
            mover(picout,-shiftup,-boxwidth/2);
}

         end;

         boxr(picout, scalev, boxwidth);

         mover(picout,returnx,returny);
      end;

      (* move to position ready to write next number *)
      mover(picout,returnx,returny);

      writeln(picout,'% now create the names');

      (* the FIRST title *)
      writeln(picout,'gsave');
      writeln(picout,' currentpoint translate');
      writeln(picout,' -90 rotate');
      writeln(picout,' gsave');
      writeln(picout,'  /columnnamesize ',title1^.titlenamesize:1,' def');
      writeln(picout,'  /Courier-Bold findfont columnnamesize scalefont setfont');
      writeln(picout,'  0 ',intervalsize:picwidth:picdecim,' cm rmoveto');
      writeln(picout,'  /col1x ',title1^.titlex:picwidth:picdecim,' def');
      writeln(picout,'  /col1y ',title1^.titley:picwidth:picdecim,' def');
      writeln(picout,'  col1x cm col1y cm rmoveto');
      write  (picout,'  (');
      writestring(picout,title1^.letters);
      writeln(picout,') show');
      writeln(picout,' grestore');

      (* the SECOND title *)
      writeln(picout,' gsave');
      writeln(picout,'  /columnnamesize ',title2^.titlenamesize:1,' def');
      writeln(picout,'  /Courier-Bold findfont columnnamesize scalefont setfont');
      writeln(picout,'  0 ',intervalsize:picwidth:picdecim,' cm rmoveto');
      writeln(picout,'  0 ',histogramvalue:picwidth:picdecim,' cm rmoveto');
      writeln(picout,'  /col2x ',title2^.titlex:picwidth:picdecim,' def');
      writeln(picout,'  /col2y ',title2^.titley:picwidth:picdecim,' def');
      writeln(picout,'  col2x cm col2y cm rmoveto');
      write  (picout,'  (');
      writestring(picout,title2^.letters);
      writeln(picout,') show');
      writeln(picout,' grestore');
      writeln(picout,'grestore');

      writeln(picout,'gsave');
      (* the THIRD title *)
      writeln(picout,' currentpoint translate');
      writeln(picout,' -90 rotate');
      writeln(picout,
          (-hdata.slots * boxwidth / 2):picwidth:picdecim,
          ' cm 0 cm rmoveto');
      writeln(picout,' /titlenamesize ',title3^.titlenamesize:3,' def');
      writeln(picout,' /titlex ',title3^.titlex:picwidth:picdecim,' def');
      writeln(picout,' /titley ',title3^.titley:picwidth:picdecim,' def');
      writeln(picout,' titlex cm titley cm rmoveto');
      writeln(picout,' /Courier-Bold findfont titlenamesize scalefont setfont');
      write  (picout,' (');
      writestring(picout,title3^.letters);
      writeln(picout,') show');
      writeln(picout,'grestore');

      if othertitles > 0 then begin
         t := titles;
         for o := 1 to othertitles do with t^ do begin
            writeln(picout,'gsave');
            writeln(picout,' currentpoint translate');
            writeln(picout,' -90 rotate');
            writeln(picout,
                (-(hdata.slots+2) * boxwidth):picwidth:picdecim,
                ' cm 0 cm rmoveto');
            writeln(picout,' /titlenamesize ',t^.titlenamesize:1,' def');
            writeln(picout,' /titlex ',t^.titlex:picwidth:picdecim,' def');
            writeln(picout,' /titley ',t^.titley:picwidth:picdecim,' def');
            writeln(picout,' titlex cm titley cm rmoveto');
            writeln(picout,' /Courier-Bold findfont titlenamesize scalefont setfont');
            write  (picout,' (');
            writestring(picout,t^.letters);
            writeln(picout,') show');
            writeln(picout,'grestore');
            t := t^.next
         end;
         if t <> nil then begin
            writeln(output,'buildpic: extra titles on list not accounted for');
            halt;
         end;
      end;

      (* put overlay plot onto the graph *)
      if hdata.plot <> 'n' then begin
         (* plot the curve *)
         (* move to the first point on the first box: *)

         movea(picout,-returnx (* this is the edge of the box *)
                     +scale*stanarray.numbers[1],
                     boxshift-downshift+boxwidth/2);
{zzz }
{Why downshift here?
2003 aug 22 - this is the overlay plot -
downshift is set to zero earlier if we have new parameters.
}

         dosmallbox;
         for index := 2 to hdata.slots do begin
            with stanarray do liner(picout,
               scale*(numbers[index]-numbers[index-1]),
               -boxwidth);
            dosmallbox;
         end
      end;

      stoppic(picout);
end;
(* end module genpic.buildpic *)

(* begin module postscriptheader *)
procedure postscriptheader(var a: text; title, creator: string;
                          llx: real; (* lower left x *)
                          lly: real; (* lower left y *)
                          urx: real; (* upper left x *)
                          ury: real  (* upper left y *)   );
(* Start writing postscript to file a.  This can be used to in conjunction
with makepageedges.  REQUIRES: postscript.const *)
begin
   writeln(a,'%!PS-Adobe-2.0 EPSF-2.0');
   write  (a,'%%Title: ');
   writestring(a, title);
   writeln(a,' ',version:4:2);
   write(a,'%%Creator: '); 
   writestring(a, creator);
   writeln(a);
   writeln(a,'%%BoundingBox:',
             ' ',round(llx):5,
             ' ',round(lly):5,
             ' ',round(urx):5,
             ' ',round(ury):5);
(*
BoundingBox values must be integer according to the Red book, page 234
             ' ',llx:5:1,
             ' ',lly:5:1,
             ' ',urx:5:1,
             ' ',ury:5:1);
*)
   writeln(a,'%%DocumentFonts:');
   writeln(a,'%%EndComments');

   (* 2005 Aug 6 Try to fool acrobat.  when an image is rotated 90
   degrees, Acrobat will reorient it.  STOOOOPPPPPIIIIDDD.  So use two
   45 degree rotations to avoid the problem.  Maybe some day this bug
   in Acrobat will be fixed tna the following will help.  For now it
   just provides a tad more control but does not solve the problem. *)
   writeln(a,'%%BeginDefaults');
   writeln(a,'%%PageOrientation: Portrait');
   writeln(a,'%%EndDefaults');
   writeln(a,'%%Orientation: Portrait');

   writeln(a,'/defaultllx ',defaultllx:5:1,' def');
   writeln(a,'/defaultlly ',defaultlly:5:1,' def');
   writeln(a,'/defaulturx ',defaulturx:5:1,' def');
   writeln(a,'/defaultury ',defaultury:5:1,' def');
   writeln(a,'/llx ',llx:5:1,' def');
   writeln(a,'/lly ',lly:5:1,' def');
   writeln(a,'/urx ',urx:5:1,' def');
   writeln(a,'/ury ',ury:5:1,' def');
end;
(* end module postscriptheader version = 5.27; (@ of prgmod.p 2005 Aug 06 *)

(* begin module initpostscript *)
procedure initpostscript(var title, creator: string;
                         x: real; (* parameter: lower left x *)
                         y: real; (* parameter: lower left y *)
                         graphheight: real; (* parameter: graphheight *)
                         boxwidth: real; (* parameter: width *)
                         title1,title2,title3: titleptr; (* titles *)
                         var  llx: real; (* lower left x *)
                         var  lly: real; (* lower left y *)
                         var  urx: real; (* upper left x *)
                         var  ury: real; (* upper left y *)
   edgecontrol: char; (* if 'p' then use page instead of edges *)
   edgeleft, edgeright, edgelow, edgehigh: real); (* edges around the fig *)
(* initialize some postscript variables
code taken from lister.p *)
var
   cmfactor: real; (* convert from cm to points *)
begin

      (* conversion factor from cm to points *)
      cmfactor := 72 / 2.54 ; (* (72 points / inch) / (2.54 cm per inch) *)

      clearstring(title);
      title.letters[1] := 'g';
      title.letters[2] := 'e';
      title.letters[3] := 'n';
      title.letters[4] := 'p';
      title.letters[5] := 'i';
      title.letters[6] := 'c';
      title.length := 6;

      clearstring(creator);
      creator.letters[ 1] := 'T';
      creator.letters[ 2] := 'o';
      creator.letters[ 3] := 'm';
      creator.letters[ 4] := ' ';
      creator.letters[ 5] := 'S';
      creator.letters[ 6] := 'c';
      creator.letters[ 7] := 'h';
      creator.letters[ 8] := 'n';
      creator.letters[ 9] := 'e';
      creator.letters[10] := 'i';
      creator.letters[11] := 'd';
      creator.letters[12] := 'e';
      creator.letters[13] := 'r';
      creator.length := 13;

      (* compute the bounds of the figure *)
      if edgecontrol = 'p' then begin (* default page edges *)
         (* Note:  deltaXcm and deltaYcm are applied in the
            PostScript startpage routine in this mode. *)
         llx := defaultllx;
         ury := defaultury;
         urx := defaulturx;
         lly := defaultlly;
      end
      else begin (* page edges shrink wrap to the figure *)
         llx := defaultllx;
         ury := defaultury;
         urx := defaulturx;
         lly := defaultlly;

{
         llx := defaultllx + (x
                             -0  (* fudge factor to give initially extra space *)
                             )*cmfactor;
}
         llx := defaultllx; (* poo.  give page width *)

         lly := defaultlly + (y
                               -title1^.titley
                               -title2^.titley
                               -title3^.titley
                             -2  (* fudge factor to give initially extra space *)
                             )*cmfactor;
{
         urx := defaultllx + (x+boxwidth*30
                             +1  (* fudge factor to give initially extra space *)
                             )*cmfactor;
}
         urx := defaulturx; (* poo.  give page width *)

         ury := defaultlly + (y+graphheight + 1
                             +1  (* fudge factor to give initially extra space *)
                             )*cmfactor;

      end;

      (* extra edge control *)
      llx := llx - edgeleft  * cmfactor; (* C1 *)
      urx := urx + edgeright * cmfactor;
      lly := lly - edgelow   * cmfactor;
      ury := ury + edgehigh  * cmfactor; (* C2 *)

end;
(* end module initpostscript *)

(* begin module themain *)
procedure themain(var histog, genpicp, picout: text);
(* the main procedure of the program *)
var
   data: histdata; (* data about the histogram *)

   (* control parameters: *)
   barlocation: integer; (* where to put a vertical bar *)
   graphheight: real; (* height of the y axis of maximum box height *)
   boxheight: real; (* maximum height of boxes *)
   boxwidth: real; (* width of boxes *)
   intervalsize,histogramvalue,boxshift: real;
   downshift: real; (* amount that the graph is shifted down to make
      space for the header information *)
   ifield, idecimal, nfield: integer;
   modulo: integer; (* modulo for which numbers are shown *)
   modulomultiplier: real; (* modulo multiplier *)
   rotation: real; (* angle to rotate the graph *)
   title: string; (* program name for postscript *)
   creator: string; (* creator name for postscript *)
   x: real; (* x coordinate of graph start, cm *)
   y: real; (* y coordinate of graph start, cm *)

   title1: titleptr; (* the first title *)
   title2: titleptr; (* the second title *)
   title3: titleptr; (* the third title *)

   othertitles: integer; (* number additional titles *)
   titles: titleptr; (* additional titles *)

   (* bounding box definitions: *)
   llx: real; (* lower left x *)
   lly: real; (* lower left y *)
   urx: real; (* upper left x *)
   ury: real; (* upper left y *)

   edgecontrol: char; (* if 'p' then use page instead of edges *)
   edgeleft, edgeright, edgelow, edgehigh: real; (* edges around the fig *)

   yaxiscontrol: char; (* if 'y' then give y axis *)
   yaxismax,  (* maximum size of y axis, counts *)
   yaxisintervals, (* interval sizes for y axis *)
   yaxissubintervals: integer; (* number of intervals for y axis *)
   yaxisticlength, yaxisticdx, yaxisticdy: real;
      (* y axis tic controls: length and positioning of the tic mark *)

   xaxiscontrol: char; (* if 'x' then give x axis *)
   xaxismax,  (* maximum size of x axis, counts *)
   xaxisintervals, (* interval sizes for x axis *)
   xaxissubintervals: integer; (* number of intervals for x axis *)
   xaxisticlength, xaxisticdx, xaxisticdy: real;
      (* x axis tic controls: length and positioning of the tic mark *)

   dobugreport: boolean; (* whether to tell the user how to fix the
                            version 2.26 bug *)
procedure bugreport;
(* tell the user exactly how to fix the bug *)
begin
   writeln(output,'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@');
   writeln(output,'@ Here is how to fix the bug: @');
   writeln(output,'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@');

   write  (output,'change your x coordinate from ',x:1:4,' cm');
   writeln(output,' to ',(x-(downshift*1)):1:4,' cm');

   writeln(output,'downshift: ',downshift:8:2);
   writeln(output,'boxwidth: ',boxwidth:8:2);
   writeln(output,'lines = downshift/boxwidth: ',downshift/boxwidth:8:2);
end;

begin
   writeln(output,' genpic ',version:4:2);

   getdata(histog,data);

   readparam(genpicp,
          x, y, rotation,
          graphheight,boxwidth,intervalsize,histogramvalue,boxshift,
          ifield,idecimal,nfield,modulo,modulomultiplier,barlocation,
          title1, title2, title3,
          othertitles, titles,
          edgecontrol, edgeleft, edgeright, edgelow, edgehigh,
          xaxiscontrol, xaxismax, xaxisintervals, xaxissubintervals,
          xaxisticlength, xaxisticdx, xaxisticdy,
          yaxiscontrol, yaxismax, yaxisintervals, yaxissubintervals,
          yaxisticlength, yaxisticdx, yaxisticdy,
          dobugreport);

   initpostscript(title, creator,
          x, y, graphheight, boxwidth,
          title1, title2, title3,
          llx, lly, urx, ury,
          edgecontrol, edgeleft, edgeright, edgelow, edgehigh);

   rewrite(picout);
   postscriptheader(picout, title, creator, llx, lly, urx, ury);

   writeparam(picout, '%',
          x, y, rotation,
          graphheight,boxwidth,intervalsize,histogramvalue,boxshift,
          ifield,idecimal,nfield,modulo,modulomultiplier,barlocation,
          title1, title2, title3,
          othertitles, titles,
          edgecontrol, edgeleft, edgeright, edgelow, edgehigh,
          xaxiscontrol, xaxismax, xaxisintervals, xaxissubintervals,
          xaxisticlength, xaxisticdx, xaxisticdy,
          yaxiscontrol, yaxismax, yaxisintervals, yaxissubintervals,
          yaxisticlength, yaxisticdx, yaxisticdy);


   startpic(picout, defscale, x, y, 'c');

   writeln(picout,'/cmfactor 72 2.54 div def % defines points -> centimeters');
   writeln(picout,'/cm { cmfactor mul} def % defines centimeters');

   writeln(picout, '2 setlinecap');

   (* 2005 Aug 6.  Acrobat will re-rotate the image when it has been
   rotated exactly 90 degrees.  Other angles are not affected. 
   STOOOOOOOPPPPPIIIIIDDDDD!!  To avoid this problem, fool acrobat by
   doing two 45 degree rotations! *)

   if idecimal = 0
   then write(picout,round(45+rotation):ifield)
   else write(picout,45+rotation:ifield:idecimal);
   writeln(picout,' rotate');
   writeln(picout,'45 rotate');

   writeln(picout);

   writeln(picout,'%%EndProlog');
   writeln(picout,'%%Page: 1');

   putdata(picout, data);
   putdata(output, data);

   copystart(histog,picout,boxwidth,downshift);

{
   xaxiscontrol := 'x';
   xaxismax := 17;  (* maximum size of x axis, counts *)
   xaxisintervals := 5; (* interval sizes for x axis *)
   xaxissubintervals := 5; (* number of intervals for x axis *)
   xaxisticlength := 0.1;
   xaxisticdx := 0.00;
   xaxisticdy := -1.0;
}

   if xaxiscontrol = 'x' then begin
      (* draw an x axis starting from the current position. *)
      writeln(picout, 'gsave');
      writeln(picout, '-90 rotate');
      (* move the x axis into the right location: *)
      writeln(picout, (-boxwidth/2):picwidth:picdecim, ' cm ',
                      (intervalsize + histogramvalue):picwidth:picdecim,
                      ' cm translate');
      writeln(picout,'0 0 moveto');

{
writeln(output,'boxwidth ',boxwidth:10:2);
writeln(output,'start    ',data.start   :10:2);
writeln(output,'stop     ',data.stop    :10:2);
writeln(output,'xaxismax     ',xaxismax:10);
}

(* 2007 Nov 28: somethin's wrong here:
      xaxis(picout, {afile}
         true, { doaxisline: boolean;  line on axis is plotted }
         (xaxismax-data.start)*boxwidth, data.start, xaxisintervals, xaxismax,
           { aylength,fromtic,interval,totic: real;}
         xaxissubintervals, { xsubintervals: real;}
         xaxisticlength, xaxisticdx, xaxisticdy, { length, dx, dy: real;}
         20, 0, { width, decimal: integer;}
         false, false, { logyscale, logynormal: boolean;}
         2); { logybase: real;}
*)
{
procedure xaxis(var afile: text;
         doaxisline: boolean;  (* line on axis is plotted *)
         axlength,fromtic,interval,totic: real;
         xsubintervals: real;
         length, dx, dy: real;
         width, decimal: integer;
         logxscale, logxnormal: boolean;
         logxbase: real);
faiiled tries:
         (xaxismax-data.start)*boxwidth, fails
         (xaxismax-data.start)/(xaxisintervals/xaxissubintervals)*boxwidth,
         (xaxismax-data.start)/(xaxisintervals/2)*boxwidth, works-but why?
                                               2?
         (xaxismax-data.start)/(xaxisintervals)*boxwidth,
qqq

writeln(output, 'xaxismax: ', xaxismax:10);
writeln(output, 'data.start: ', data.start:10:8);
writeln(output, 'boxwidth: ', boxwidth:10:8);
writeln(output, '(xaxismax-data.start)*boxwidth: ', (xaxismax-data.start)*boxwidth:10:8);
writeln(output, 'xaxissubintervals: ', xaxissubintervals:10);
writeln(output, 'xaxisintervals: ', xaxisintervals:10);

writeparam(output, '%',
          x, y, rotation,
          graphheight,boxwidth,intervalsize,histogramvalue,boxshift,
          ifield,idecimal,nfield,modulo,modulomultiplier,barlocation,
          title1, title2, title3,
          othertitles, titles,
          edgecontrol, edgeleft, edgeright, edgelow, edgehigh,
          xaxiscontrol, xaxismax, xaxisintervals, xaxissubintervals,
          xaxisticlength, xaxisticdx, xaxisticdy,
          yaxiscontrol, yaxismax, yaxisintervals, yaxissubintervals,
          yaxisticlength, yaxisticdx, yaxisticdy);
}

      xaxis(picout, {afile}
         true, { doaxisline: boolean;  line on axis is plotted }
         (xaxismax-data.start)/(data.xinterval)*boxwidth, {aylength}
         data.start, xaxisintervals, xaxismax,
           {fromtic,interval,totic: real;}
         xaxissubintervals, { xsubintervals: real;}
         xaxisticlength, xaxisticdx, xaxisticdy, { tic length, dx, dy: real;}
         20, 0, { width, decimal: integer;}
         false, false, { logyscale, logynormal: boolean;}
         2); { logybase: real;}

      writeln(picout, 'grestore');
   end;


   if yaxiscontrol = 'y' then begin
      (* draw a y axis starting from the current position. *)
(* Test code for locating where the drawing point is.
writeln(picout, 'gsave');
writeln(picout, '-90 rotate');
writeln(picout, '0 0 moveto');
writeln(picout, '   gsave');
writeln(picout, '      1 cm 1 cm lineto');
writeln(picout, '      0 1 0 setrgbcolor');
writeln(picout, '      stroke');
writeln(picout, '   grestore');
writeln(picout, '   gsave');
writeln(picout, (-boxwidth):picwidth:picdecim, ' cm 0 cm rmoveto');
writeln(picout, '      1 cm 1 cm rlineto');
writeln(picout, '      1 0 0 setrgbcolor');
writeln(picout, '      stroke');
writeln(picout, '   grestore');
writeln(picout, 'grestore');

writeln(output, (boxwidth):picwidth:picdecim, ' boxwidth');
writeln(output, (intervalsize):picwidth:picdecim, ' intervalsize');
*)

      writeln(picout, 'gsave');
      writeln(picout, '-90 rotate');
      (* move the y axis into the right location: *)
      writeln(picout, (-boxwidth):picwidth:picdecim, ' cm ',
                      (intervalsize + histogramvalue):picwidth:picdecim,
                      ' cm translate');
      writeln(picout,'0 0 moveto');

      yaxis(picout, {afile}
         true, { doaxisline: boolean;  line on axis is plotted }
         graphheight, 0, yaxisintervals, yaxismax,
           { aylength,fromtic,interval,totic: real;}
         yaxissubintervals, { ysubintervals: real;}
         yaxisticlength, yaxisticdx, yaxisticdy, { length, dx, dy: real;}
         20, 0, { width, decimal: integer;}
         false, false, { logyscale, logynormal: boolean;}
         2); { logybase: real;}
      writeln(picout, 'grestore');
      boxheight := graphheight * ( data.ymaximum / yaxismax);
   end
   else begin
      boxheight := graphheight;
   end;

{ I don't know exactly how to compute this yet
   if dobugreport then bugreport;
In theory the exact number can be found, and then the parameter
file corrected.  Maybe.
}

   buildpic(data,histog,picout,
          boxheight,boxwidth,intervalsize,histogramvalue,boxshift,
          ifield, idecimal, nfield, modulo, modulomultiplier,
          barlocation, downshift,
          title1, title2, title3,
          othertitles, titles,
          xaxiscontrol,
          yaxiscontrol);

   writeln(picout,'%%Trailer');
   writeln(picout,'%%Pages: 1');

end;
(* end module themain *)

begin
      themain(histog,genpicp,picout);
1: end.