program makewalker(book, ribl, colors, makewalkerp, walk, output);
(* makewalker: walk an information weight matrix across a sequence

  Dr. Thomas D. Schneider
  toms@alum.mit.edu
  permanent email: toms@alum.mit.edu (use only if first address fails)
  https://alum.mit.edu/www/toms/

 *)

label 1; (* end of program *)

const
(* begin module version *)
   version = 3.61; (* of makewalker.p 2006 Jul 07
2006 Jul 07, 3.60 program does not run in gs anymore!
                  Although the programmed display in the walk file
                  works, commands are refused from the command line
                  and gs crashes.
                  Somehow the commands are all lost!
                  GS>Error: /undefined in h
2005 Sep 15, 3.59 make stronger parameter testing
2005 May 23, 3.58 GPC compiles this just fine, add patent message
2001 Jan 24, 3.57 switch to sun compiler for now
2000 Jul 30, 3.56 upgrade to GPC
1999 Dec 13, 3.55 upgrade y2k and delila modules
1999 Aug 15, 3.53 upgrade to new prgmod modules, to allow new ribl reading
1998 February 27 previous version
version control added 1996 October 8
program renamed makewalker (formerly called walker) 1996 October 8
invert function added 1996 July 23
origin 1994 November 1 *)
updateversion = 3.42; (* defines lowest acceptable current parameter file *)
(* end module version *)

(* begin module describe.makewalker *)
(*
name
   makewalker: walk an information weight matrix across a sequence

synopsis
   makewalker(book: in, ribl: in, colors: in, makewalkerp: in,
          walk: out, output: out)

files
   book: a book from the Delila system

   ribl: a weight matrix from the Ri program

   colors: definitions of how to color letters.  See makelogo.p for details.

   makewalkerp:  parameters to control this program

      The first line must be the version number of the program.
      This allows the program to recognize when the parameter file is old.

      rangefrom: integer, FROM of the ribl matrix to use.
      rangeto: integer, TO of the ribl matrix to use.

      basesperline: integer, number of bases per line to display.

      linesperpage: integer, number of lines per page to display.

      basenumber: integer, the base on the line to place the zero of the walker
         at initially on the page.  It must be between 0 and basesperline - 1.
         Counting begins at zero on the left side of the page.

      linenumber: integer, the line number to place the zero of the walker at
         initially on the page.  It must be between 0 and linesperpage - 1.
         Counting begins at zero on the bottom of the page.

      coornumber: integer, the coordinate number to place the zero of the
         walker at initially.  If this number is not found in the piece
         coordinate system, the walker will be placed at the beginning of the
         sequence when coornumber's value is zero or negative and placed at the
         end of the sequence when coornumber's value is positive.

      pagewidth: real, the width of the lines of sequence in cm.
      pageheight: real, the height of the lines of sequence in cm.
      pagex: real, the x coordinate of the page lower left corner in cm.
      pagey: real, the y coordinate of the page lower left corner in cm.

      lowerbound: real < 0, the lowest Ri(b,l) value in bits that can be fully
         displayed (bases with lower values are clipped and have a red line on
         the bottom).

      boxes: charcter: if 'b' then the walker characters are surrounded by
         character-boxes as defined below.  Otherwise the boxes are invisible.

      outofsequence: charcter: if 'o' then the walker is set next to the
         sequence.  Otherwise the walker is in line with the sequence.  Thanks
         to Seth Taylor for suggesting this option on 1994 November 22.

      ALL LINES FOLLOWING THIS POINT:  These are inserted into the walk
         as commands before the initial display.

   walk:  A postscript program that implements the walk.
      It is to be run with ghostscript:
         gs -q walk
      Ghostscript then pops up a graphics window and the user types commands to
      control the display.  (The -q just makes ghostscript quiet on startup.)
      The program reports information to the user that include the position,
      the individual information for the current position (Ri, bits) and the Z
      score for this Ri given the mean (Rsequence) and standard deviation of
      the original population of sequences used to create the ribl matrix.
      When the absolute value of the Z score is less than or equal to 2, an
      arrow (<---) indicates that the position is likely to be a site.
      Likewise, when the Ri value is positive, this is indicated by plus signs
      (++++).  (The actual test can be set by the user.)  The user can type '?'
      or 'help' to get a list of commands.  These commands are discussed in
      further detail below.

      NOTE: the Ri evaluation is ONLY for the portion of the walker displayed
      on the screen.

   output:  Messages to the user.

description
   This program creates a PostScript program, called the "walk", by
   reformatting the DNA sequences in a Delila book and joining them to the ribl
   matrix.  The user then runs the "walk" using the interactive PostScript
   interpreter ghostscript.  Within the ghostscript graphic page appears part
   or all of the sequence(s) in the book.  The majority of the letters are
   black, but a portion are in color.  These letters correspond to the
   evaluation of those bases by the Ri(b,l) matrix read from the ribl file.
   The height of each letter is proportional to its weight in the matrix.  Thus
   the user can immediately see the components of the weight matrix as applied
   to the particular sequence.  The user may then type commands to move the
   evaluated region around.  The user literally walks the evaluation across the
   sequence, and thereby gains a sense of the reaction each part of the
   recognizer to each part of the sequence.

   GENERAL SCHEME OF A WALKER PAGE

   A walker page consists of a rectangular array of character boxes:

      <------------- basesperline ------------>  (10 in this case)
        0   1   2   3   4   5   6   7   8   9

   ^  -----------------------------------------         ^
p  |  |152|153|154|155|156|157|158|159|1  |2  |         |
a  |  |   |   |   |   |   |   |   |   |   |   | 2       |
g  |  |   |   |   |   |   |   |   |   |   |   |         |
e  |  |   |   |   |   |   |   |   |   |   |   |         |
h  |  -----------------------------------------         |
e  |  |3  |4  |5  |6  |7  |8  |9  |10 |11 |12 |         |
i  |  |   |   |   |   |   |   |   |   |   |   | 1   linesperpage
g  |  |   |   |   |   |   | ! |   |   |   |   |   (3 in this case)
h  |  |   |   |   |   |   |   |   |   |   |   |         |
t  |  -----------------------------------------         |
   |  |13 |14 |15 |16 |17 |18 |19 |20 |21 |22 |         |
(  |  |   |   |   |   |   |   |   |   |   |   | 0       |
c  |  |   |   |   |   |   |   |   |   |   |   |         |
m  |  |   |   |   |   |   |   |   |   |   |   |         |
)  v  *----------------------------------------         v
     *
    * <----------- pagewidth (cm) ------------>
   *
   **** lower left hand corner is at pagex horizontal (cm) and pagey vertical
   (cm) on the page, starting from the PostScript default zero coordinate.

   The "!" is at basenumber = 5, linenumber = 1, coornumber = 8

   All the parameters: basenumber, linenumber, coornumber, basesperline,
   linesperpage, pageheight, pagex and pagey are defined independently.  The
   physical positioning parameters pagex, pagey, pagewidth and pageheight
   determine where the entire set of character boxes is placed on the page.
   Each character box size is determined by the basesperline and linesperpage
   so that the required number fit the defined area of the page.  The zerobase
   of the walker is set initially at the coordinate given by basenumber and
   linenumber.  The coordinates of the bases for the rest of the sequence are
   determined by the coordinate of the zerobase of the walker.

   Note that the coordinate system in the example above represents a fragment
   of a circular DNA, with coordinates running from 152 up to 159, followed by
   a jump to the start of numbering at 1 and then proceeding up to 22.  (These
   kinds of coordinates can be generated and handled by Delila programs.)



   GENERAL SCHEME OF A WALKER CHARACTER BOX

   +---+ <-- 2 bits per base
   |   |
   |---| <-- 0 bits per base
   |   |
   |   |
   |   |
   +---+ <-- lowerbound bits per base

   The box has a part above zero in which letters appear upright and a part
   below zero in which the letters appear rotated 180 degrees if they are
   within the evaluated region or black and upright if they outside.

   If the walker is out of the sequence, then a gap of height 1 bit is
   created just above the 2 bits mark.  The sequence is put there.  The rest
   of the characterbox is scaled accordingly.

   Bases which have positive Ri(b,l) values run upward from 0 to 2 bits,
   those that have a negative value run downward.  If a base evaluates to a
   number of bits lower than lowerbound, it will be drawn down but any amount
   below lowerbound is cutoff.  To indicate this situation, the background
   becomes purple.  If the base has a value less than -log2(n) bits (where n
   is the number of sequences used to make the ribl model), it is considered
   to be negative infinity, and the background becomes black.

   COMMANDS

   When the walk program is run in GhostView, the user can control the
   display by means of typed commands.  These commands are built from
   PostScript procedures.  This means that any arguments must be given before
   the command itself.  This may feel a little strange at first, bit it is
   easy to get used to.  For example, to go to location 132, the user types:

       132 goto<cr>

   where <cr> is a carriage return.

   # means that the command is proceeded by a number.
   * means not implemented yet

   Movement Commands:  These commands affect the direction that the walker or
   the sequence moves.  Which moves depends on the w command.  The commands
   are the same as those of the Unix editor vi.

   # h: move left on the page (# is optional)

   # j: move down on the page (# is optional)

   # k: move up on the page (# is optional)

   # l: move right on the page (# is optional)

   Move commands may have an integer in front which says how many times to
   move.  The program will repeat the command.

*  n: next sequence

*  p: previous sequence

   w: A toggle between two states:
      the walker   moves along the stationary sequence,
         or
      the sequence moves along the stationary walker.

   q: quit

   ?: help message

   r: Refresh the page.

   R: restore or restart ghostscript on the current walk file.  This allows
      one to start over or to modify the walk and restart without quitting
      ghostscript.  The modification could be done by the makewalker program,
      by hand-editing or by another program.

   cl: clear the ghostscript command screen.

   # A,C,G,T: Mutate the given absolute location to the desired base.  For
      example, to set base 100 to be an "A", type "100 A".

   # a,c,g,t: Mutate the given relative location to the desired base.  The
      location is relative to the current position of the walker.  For
      example, to set the base 10 to the left of the walker zero to be an
      "a", type "-10 a".

   # setwait: set the wait time in seconds after display (starts at zero)

   # isasecond: set the number of {1 pop} cycles per second.  This depends on
     how fast your computer is and should be adjusted.

   # goto: Type a coordinate and then "goto".  For example, to get to
      coordinate 100 type "100 goto".  The zero base of the walker will be
      set to the coordinate.

   # invert: invert the Ribl matrix.  This is only useful if you have an
     asymmetric binding site.

   # jump: Like goto except one gives the relative number of bases to move.
      For example, to move 5 bases in the 5' direction, type "-5 jump".  The
      zero base of the walker will be set to the new coordinate.

   boxes: toggle between having boxes and not.  These are mostly helpful
      for seeing where things are on the page.

   # lines: Set the number of lines per page, eg type "3 lines".

   # bases: Set the number of bases per page, eg type "30 bases".
     ("wide" can also be used)

   # left, right, up, down: move the graphic on the page in units of cm.
      example: "0.5 right" moves the graphic right half a cm.

   # height, width: set the page height or width in cm.

   in: Put the walker into the sequence.

   out: Put the walker out of the sequence.

   # wave: define base at which the low point of the cosine wave is set.
      example: "5 wave" puts the low point at base +5.

   waveon: Turns on drawing the wave.

   waveoff: Turns off drawing the wave.

   toggleprinting or tp: a toggle that turns on and off printing.  This allows
     one to give several commands without seeing the display change.  Turning
     printing on automatically causes a display.
     NOTE:  printing is initially off to allow displays to be created without
     showing anything.  It may be turned on as the first user command
     following the other makewalkerp parameters.

   toggleerase or te: a toggle that turns on and off eraseing the page.  In
     conjunction with the toggleprinting command this allows one to display
     several walkers on a page for making a figure.

   togglereport or tr: a toggle that turns on and off reports to output.
     If it is placed as the first user defined command in the makewalkerp,
     then there will be no output messages and ghostview will not put
     up a display message.  This is useful for embedding in another figure.

   # from: change FROM range of the matrix to use
   # to: change TO range of the matrix to use

   help: help message

   # setri: set minimum Ri for searching and display
   # setz: set minimum Z for searching and display
   # f: search forward to next site which fits search criteria
   # b: search backward to next site which fits search criteria

   TO MAKE PRINTOUTS

   The walker is interactive, which means that the PostScript showpage function
   is not called since it would pause the screen and then wipe out the display
   at every command.  However, printers require showpage and if it is not
   inculded they won't print anything.  If you do this they will spend a few
   minutes rendering the page and then nothing will come out!  To make
   printouts, attach:

   gsave showpage grestore

   to the end of the walk file.   The gsave/grestore assure that the graphics
   state is not lost during the showpage.  You can put any commands you like in
   front of the showpage:

   180 goto boxes out showpage

   This allows one to set up the page as desired.

   TO IMBED IN FIGURES

   In addition to the note above about showpage, the walk file contains
   commands that translate the image.  To prevent these from affecting the
   surrounding PostScript, they must be enclosed in a gsave-grestore pair.
   The gsave is provided at the start of the walk file.  The grestore is
   provided by the q command.

   Commands can be put at the end of the parameter (makewalkerp) file.  The
   command toggleprint is called before and after these commands, so the
   commands are normally not seen.  If you surround your commands with calls
   to toggleprint, you will see a movie of the actions taken.

   The command toggleerase allows one to draw several walkers on a page,
   merely by preventing the previously drawn one from being erased.  However,
   if a figure is imbedded into an AdobeIllustrator figure and toggleerase is
   called when printing is active, this action may wipe out other parts of
   the figure.  This can be prevented by turning off the erase with
   toggleerase before turning on the printing with toggleprint.

   If the command togglereport is the first command, then the messages sent
   to standard output, which appear on the ghostscript control window, are
   all suppressed (errors are still reported).  This prevents a display
   window from popping up in ghostview.

   This is an example of what to add to the end of the makewalkerp to make a
   figure:

   togglereport  % turn off messages to output
   waveoff 5 up  % do some things silently
   toggleerase   % do this before the toggleprint
   toggleprint   % turn on printing
   6 down l      % jump around
   toggleprinting toggleprinting % force printing
   6 down l      % jump around
   toggleprinting toggleprinting % force printing
   showpage

   Do not use copypage for figures as this halts the display.

   ACKNOWLEDGMENTS

   I thank Seth Taylor for suggesting the mode for the walker being outside
   the sequence, Paul Hengen for suggesting the cosine wave applied to the
   letters and Denise Rubens for suggesting the mutation function.

examples

-10    rangefrom: integer, FROM of the ribl matrix to use
+10    rangeto: integer, TO of the ribl matrix to use
50     basesperline: integer, number of bases per line to display.
3      linesperpage: integer, number of lines per page to display.
20     basenumber: integer, the base on the line to place the zero of the walker
1 0    linenumber: integer, the line number to place the zero of the walker
132    coornumber: integer, the coordinate number to place the walker zero
18.5   pagewidth: real, the width of the lines of sequence in cm.
24.9   pageheight: real, the height of the lines of sequence in cm.
1.5    pagex: real, the x coordinate of the page lower left corner in cm.
1.5    pagey: real, the y coordinate of the page lower left corner in cm.
-4     lowerbound: real < 0, the lowest Ri(b,l) value in bits displayed
nb     boxes: b: boxes around each character
io     insequence: i: in the sequence, else out
% all lines from this point on are PostScript commands
% The "%" makes a comment
% makewalkerp: parameters for makewalker 3.03 and higher
% The following commands make a picture of 2 walkers
% waveoff       % turn off waves
1 lines       % display only one line
10 up         % move 10 cm up
5 height      % make the line only 5 high
44 wide       % show 44 characters across
w 5 h w       % move the sequence 5 positions left
132 goto      % put the walker in a new spot
toggleprinting toggleprinting % force printing
toggleerase   % prevent erasing during the next steps
6 down        % jump 6 cm down
143 goto      % put the walker in a new spot
toggleprinting toggleprinting % force printing
% gsave showpage grestore % unearth the command if you send this to a printer!

documentation
   Ghostscript documentation can be found from:
<a href = http://www.cs.wisc.edu/~ghost/index.html>
          http://www.cs.wisc.edu/~ghost/index.html</a>

see also
   delila.p, makelogo.p, ri.p, scan.p, dnaplot.p

author
   Thomas Dana Schneider

bugs

   Known Bughs:

   Only one sequence is loaded from the book.

   With parameter for 3 lines, reset to 1 line puts the entire display too
   low.  Yet starting with 1 line it's ok.  Some global parmaeter is not being
   set in definepageparameters.  (Same thing: When there is one line per page
   the position is too low, one needs to use (eg) "5 up".)

   180 goto 1 goto - it doesn't erase old stuff to left!

   Something uses up virtual memory every time the walker takes a step.
   Eventually this causes an error and GhostScript dies:

Error: /VMerror in --charpath--
VM status: 0 16061098 16168018
Current file position is 5
XIO:  fatal IO error 12 (Not enough memory) on X server ":0.0"
      after 47675 requests (45252 known processed) with 2497 events remaining.

   Why?

   When number of lines per page is changed, the cosine wave height does not
   change correctly, often being too small.  (Apparently fixed.)

   The display glitches sometimes by leaving behind pieces that should get
   erased.   This occurs when numbers are being are displayed that don't fit
   into the available area and get clipped.  A relevant location in the code is
   in the routine displaywalker at: "white 0 0 charbox fill" A replacement
   replacement:  "0 0 charbox clip erasepage initclip" does not help.  Perhaps
   this is the wrong part of the code.  It is also possible that the problem is
   in ghostscript.  The effect sometimes occurs as one is moving the walker
   around.  Letters that are drawn that go below the lower bound don't get
   clipped properly, they leave a slight edge there.

   Range checking does not work properly.  If the ribl has a range
   from -100 to +99, then a request for -99 to +100 bombs.  This
   should be caught in walker.

   Perhaps there should be a function that automatically defines the
   lower bound in bits so that the user does not need to figure thisout.

   Resetting lower bound messes up the display!

   f (and probably b) searches don't work when the display is toggled
   off.  Fortunately this is easy to get around:  just determine the
   locations and use goto.

   If one has a small sequence, visible on the screen and then sets the move
   mode to move the sequence with the walker steady (ie use the w toggle),
   then when the end of the sequence moves in, the last character is not
   removed, so there are repeating bases on the end.

technical notes

   Note: encapsulation of the figure requires a gsave and a grestore to
   surround the walk code to undo the translation to the basenumber = 0,
   linenumber = 0 coordinate and any other translations done by commands.

   No showpage is provided, since this does not help during interactive
   graphics.  Worse, ghostscript pauses at every showpage or copypage, saying:

   ">>copypage, press <return> to continue<<"

   So the user would be forced to type extra carriage returns for every
   command.  If a showpage is needed for making a printout, it must be added
   later as "gsave showpage grestore.

   isasecond is a global constant that defines the number of {1 pop} operations
   that the display can run through in 1 second.  This must be determined for
   each computer.

   The bounding box for EPS is defined in the constants.

*)
(* end module describe.makewalker *)

(* begin module string.const *)
      maxstring = 2000; (* the maximum string *)
(* end module string.const version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module ribl.const *)
   minribl = -10001; (* lowest  ribl matrix from allowed *)
   maxribl = +10001; (* highest ribl matrix to   allowed *)
   defnegativeinfinity = -1000; (* default for negative infinity
                                   for the Ri(b,l) table *)
(* end module ribl.const version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module info.const *)
   infofield = 10; (* size of field for printing information in bits *)
   infodecim = 6; (* number of decimal places for printing information *)
       (* these are used for conlist only *)
   nfield = 8; (* size of field for printing n, the number of sites *)
(* end module info.const version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module makewalker.const *)
       (* these are used for conlist only *)
   isasecond = 100000; (* this number of {1 pop} operations
                          should take 1 second *)
   gooddisplay = false; (* see technical notes in makelogo.p for explanation. *)
   outline = false;  (* don't use outline characters in walker *)
   showingbox = false;  (* show the box around the character when debugging *)
   shrinking = false;  (* shrink the character inside its box *)

   (* bounding box definitions: *)
   (* the following bounding box is for the inkjet Phaser 140 *)
   llx =  14.4; (* lower left x *)
   lly =  28.9; (* lower left y *)
   urx = 596.8; (* upper left x *)
   ury = 777.7; (* upper left y *)
(* end module makewalker.const *)

(* begin module book.const *)
(* constants needed for book manipulations *)
      dnamax = 1024;  (* length of dna arrays *)
      namelength = 100; (* maximum key name length *)
      linelength = 80; (* maximum line readable in book *)
(* end module book.const version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module postscript.constants *)
   pwid = 8; (* width in character places to print PostScript numbers *)
   pdec = 5; (* decimal places to print PostScript numbers *)
   pdecolor = 4; (* decimal places for color descriptions (5 WILL CAUSE
                    NeWS 1.1 TO BOMB) *)
(* end module postscript.constants *)

(* begin module datetime.const *)

   datetimearraylength = 19; (* length of dataarray for dates,
       It is just long enough to include the 4 digit year - solving the
       year 2000 problem:
1980/06/09 18:49:11
123456789 123456789 
         1         2
*)

(* end module datetime.const version = 1.17; (@ of timegpc.p 2002 Oct 9 *)

type

(* begin module makewalker.type *)
   parameters = record (* parameters to control this program *)
      (* all definitions are given in the makewalkerp parameter definition *)
      rangefrom: integer;
      rangeto: integer;

      basesperline: integer;
      linesperpage: integer;

      basenumber: integer;
      linenumber: integer;
      coornumber: integer;

      pagewidth: real;
      pageheight: real;
      pagex: real;
      pagey: real;

      lowerbound: real;

      fractionofline: real;
(* fractionofline is not necessary so is not user settable anymore.

makewalkerp:
1     fractionofline: real 0 to 1, line fraction that bases fit into vertically

makewalkerp definition:
*     fractionofline: real 0 to 1, the fraction of 0 to 2 bits that
         the bases outside the site fit into vertically.

description:
*  Outside the walker, the letters are shrunken vertically by a factor of
   fractionofline so that they won't bump into the next line.  Normally this
   should be set to 1.
*)


      boxes: char;
      outofsequence: char;
  end;
(* end module makewalker.type *)

(* begin module datetime.type *)
   (* array for dates *)
   datetimearray = packed array[1..datetimearraylength] of char;
(* end module datetime.type version = 1.17; (@ of timegpc.p 2002 Oct 9 *)

(* begin module book.type *)
(* types needed for book manipulations *)

      chset = set of 'a'..'z';

      (* types defined in book definition *)

      alpha = packed array[1..namelength] of char; (* this is not alfa *)

      (* name is a left justified string with blanks following the
         characters *)
      name = record
         letters: alpha;
         length: 0..namelength (* zero means an unspecified structure *)
      end;

      lineptr = ^line;
      line = record (* a line of characters *)
         letters: packed array [1..linelength] of char;
         length: 0..linelength;
         next: lineptr
      end;

      direction = (plus, minus, dircomplement, dirhomologous);
      configuration = (linear, circular);
      state = (on, off);

      header = record (* header of key *)
         keynam: name; (* key name of structure *)
         fulnam: lineptr; (* full name of structure *)
         note:   lineptr (* note key *)
      end;

(* begin module base.type *)
   (* define the four nucleotide bases *)
   base = (a,c,g,t);
(* end module base.type version = 7.51; {of delmod.p 2000 Jul 25} *)

      (* sequence types *)
      dnaptr = ^dnastring;
      dnarange = 0..dnamax;
      seq = packed array[1..dnamax] of base;
      dnastring = record
         part: seq;
         length: dnarange;
         next: dnaptr
      end;


      orgkey = record (* organism key *)
         hea: header;
         mapunit: lineptr (* genetic map units *)
      end;

      chrkey = record (* chromosome key *)
         hea: header;
         mapbeg: real; (* number of genetic map beginning *)
         mapend: real (* number of genetic map ending *)
      end;

      pieceptr = ^piece;
      piekey = record (* piece key *)
         hea: header;
         mapbeg: real; (* genetic map beginning *)
         coocon: configuration; (* configruation (circular/linear) *)
         coodir: direction; (* direction (+/-) relative to genetic map *)
         coobeg: integer; (* beginning nucleotide *)
         cooend: integer; (* ending nucleotide *)
         piecon: configuration; (* configruation (circular/linear) *)
         piedir: direction; (* direction (+/-) relative to coordinates *)
         piebeg: integer; (* beginning nucleotide *)
         pieend: integer; (* ending nucleotide *)
      end;


      piece = record
         key: piekey;
         dna: dnaptr
      end;

      reference = record
         pienam : name;  (* name of piece referred to *)
         mapbeg : real;  (* genetic map beginning *)
         refdir : direction;  (* direction relative to coordinates *)
         refbeg : integer;  (* beginning nucleotide *)
         refend : integer;  (* ending nucleotide *)
      end;

      genkey = record  (* gene key *)
         hea : header;
         ref : reference;
      end;

      trakey = record  (* transcript key *)
         hea : header;
         ref : reference;
      end;

      markerptr = ^marker;
      markey = record (* marker key *)
         hea : header;
         ref : reference;
         sta : state;
         phenotype : lineptr;
         next : markerptr;
      end;

      marker = record
         key : markey;
         dna : dnaptr;
      end;

(* end module book.type version = 7.51; {of delmod.p 2000 Jul 25} *)

(* 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 *)
      previous: stringptr; (* the previous string in a series *)
      next: stringptr; (* the next string in a series *)
   end;
(* end module string.type version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module wave.type *)
      waveptr = ^waveparam; (* to link several wave definitions together *)
      waveparam = record (* parameters to define a cosine wave *)
         (* define a cosine wave: *)
         extreme: char; (* h or l, the high or low extreme to be defined *)
         wavelocation: real; (* the location in bases of the extreme *)
         wavebit: real; (* the location in bits of the extreme *)
         waveamplitude: real; (* the amplitude of the wave in bits *)
         wavelength: real; (* the wave length of the wave in bases *)
{ 2000 Nov 1.  This is difficult because the length of a curve is not
simply multiplied by a scale factor.
         BASEdashon: real; (* dashon interval in bases *)
         BASEdashoff: real; (* dashon interval in bases *)
         BASEdashoffset: real; (* dashon interval in bases *)
}
         dashon: real; (* the size of on dashes in cm.
                          dashon <= 0 means no dashes *)
         dashoff: real; (* the size of on dashes in cm *)
         dashoffset: real; (* the size of off dashes in cm *)
         thickness: real; (* thickness of the wave in cm.  <= 0 means default *)
         next: waveptr; (* the next wave *)
      end;
(* end module wave.type version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module scan.type *)
   (* define the ribl matrix.  Source library is prgmod.p
      REQUIRES ribl.const module
      REQUIRES base.type or book.type module
      REQUIRES wave.type module for wave definition! *)
   rblarray = array[a..t, minribl..maxribl] of real; (* real(B,L) *)
   ribltype = record
      riblname: string; (* name of the weight matrix *)
      riblheader: stringptr; (* misc header information, starting with '*' *)
      data: rblarray; (* real(B,L) *)
      numbers: array[a..t, minribl..maxribl] of integer; (* n(b,l) *)
      frombase, tobase: integer; (* range of the matrix *)
      mean, stdev: real; (* mean and standard deviation of distribution *)
      consensus: real; (* Ri value of consensus sequence *)
      anticonsensus: real; (* Ri value of anticonsensus sequence *)
      averageRi: real; (* average Ri for random sequence *)
      n: integer; (* number of sequences used to create matrix *)
      symmetry: char; (* the symmetry of the Riblmatrix *)
      waves: waveptr; (* cosine wave definitions for the matrix *)
      cmperbase, cmperbit: real; (* required for wave dash definition *)
      Ribound: real; (* the Ri boundary for this definition *) 
      Zbound: real; (* the Z boundary for this definition *) 
      Pbound: real; (* the probability boundary for this definition *) 
   end;
   ribltypeptr = ^ribltype; (* pointer to ribltype so it does
      not need to be created unless actually used *)
(* end module scan.type version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

var
   book, ribl, colors, makewalkerp, walk: text; (* files used by this program *)

(* begin module book.var *)
(* ************************************************************************ *)
(* global variables needed for book manipulations *)

      (* free storage: *)
      freeline: lineptr; (* unused lines *)
      freedna: dnaptr; (* unused dnas *)

      readnumber: boolean; (* whether to read a number from the notes, or
                              to read in the notes *)
      number: integer; (* the number of the item just read *)
      numbered: boolean; (* true when the item just read is numbered *)
      skipunnum: boolean; (* a control variable to allow skipping of
                             un-numbered items in the book *)

(* ************************************************************************ *)
(* end module book.var version = 7.51; {of delmod.p 2000 Jul 25} *)

(* 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 = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module package.datetime *)
(* ************************************************************************ *)
(* begin module getdatetime *)
procedure getdatetime(var adatetime: datetimearray);
(* get the date and time into a single array from the system clock.
   adatetime contains the date:
       1980/06/09 18:49:11
         ye mo da ho mi se
(year, month, day, hour, minute, second).
As of 2000 February 18, the Sun Pascal compiler requires a formatting
statement.  This statement allows the date to be generated in this
standard Delila format in a single call.  Information about the
formatting statement is available on the manual page for date in Unix.
If a computer does not have this method, see the 'oldgetdatetime' routine
in delmod.p (https://alum.mit.edu/www/toms/delila/delmod.html)
for some conversion code.

GPC Functions:
function  GetUnixTime (var MicroSecond : Integer) : UnixTimeType;

http://agnes.dida.physik.uni-essen.de/~gnu-pascal/gpc_109.html#SEC109

7.10.8 Date And Time Routines 

procedure GetTimeStamp (var t : TimeStamp); 
function Date (t : TimeStamp) : packed array [1 .. DateLength] of Char; 
function Time (t : TimeStamp) : packed array [1 .. TimeLength] of Char; 

DateLength and TimeLength are implementation dependent constants. 

GetTimeStamp (t) fills the record `t' with values. If they are valid, the Boolean
flags are set to True. 

TimeStamp is a predefined type in the Extended Pascal standard. It may be
extended in an implementation, and is indeed extended in GPC. For the full
definition of `TimeStamp', see section 8.255 TimeStamp. 

*)
var
    t: TimeStamp; 

(* begin module pluckdigit *)
function pluckdigit(number, logplace:integer): char;
(* return the digit at the place value ('logplace') position of number.
example:
      pluckdigit(13625, 3) = 3
      pluckdigit(13625, 4) = 1
This routine was taken from module numberdigit in prgmod.p, but is
modified so as not to give the sign.  Instead it gives zeros
above the digits.  'myabsolute' replaced 'absolute', which
is apparently a keyword for GPC.  The name is kept for
to keep the code looking similar to its origin.
*)
var
      place: integer; (* the exponent of logplace *)
      count: integer; (* used to make place *)
      myabsolute: integer; (* the absolute value of number *)
      acharacter: char; (* the character to be returned *)
procedure digit;
(* extract a digit at the place position *)
var
      tenplace: integer; (* ten times place *)
      z: integer; (* an intermediate value *)
      d: integer; (* the digit extracted *)
begin (* digit *)
      tenplace:=10*place;
      z:=myabsolute-((myabsolute div tenplace)*tenplace);
      if place = 1
         then d:=z
         else d:= z div place;
      case d of
         0: acharacter:='0';
         1: acharacter:='1';
         2: acharacter:='2';
         3: acharacter:='3';
         4: acharacter:='4';
         5: acharacter:='5';
         6: acharacter:='6';
         7: acharacter:='7';
         8: acharacter:='8';
         9: acharacter:='9';
      end
end; (* digit *)
begin (* pluckdigit *)
      place:=1;
      for count:=1 to logplace do place:=10*place;
      if number=0 then begin
         acharacter:='0'
      end
      else begin
         myabsolute:=number;
         if myabsolute >= place
         then digit
         else acharacter := '0'
      end;
      pluckdigit:=acharacter
end; (* pluckdigit *)
(* end module pluckdigit *)

begin

 (* according to:
http://agnes.dida.physik.uni-essen.de/~gnu-pascal/gpc_109.html#SEC109
*)
   GetTimeStamp(t); 

(* Predefined time stamp:
http://agnes.dida.physik.uni-essen.de/~gnu-pascal/gpc_389.html#SEC389
  TimeStamp = {@@packed} record
      DateValid,
      TimeValid   : Boolean;
      Year        : Integer;
      Month       : 1 .. 12;
      Day         : 1 .. 31;
      DayOfWeek   : 0 .. 6;  { 0 means Sunday }
      Hour        : 0 .. 23;
      Minute      : 0 .. 59;
      Second      : 0 .. 61; { to allow for leap seconds }
      MicroSecond : 0 .. 999999
    end;
*)

  with t do begin
    if TimeValid then begin
{
       writeln(output,'valid time');
       writeln(output,'year   =',year:4);
       writeln(output,'month  =',month:2);
       writeln(output,'day    =',day:2);
       writeln(output,'hour   =',hour:2);
       writeln(output,'minute =',minute:2);
       writeln(output,'second =',second:2);
}
       adatetime := 'year/mm/dd hh:mm:ss';
       adatetime[ 1] := pluckdigit(Year,3);
       adatetime[ 2] := pluckdigit(Year,2);
       adatetime[ 3] := pluckdigit(Year,1);
       adatetime[ 4] := pluckdigit(Year,0);
       adatetime[ 6] := pluckdigit(Month,1);
       adatetime[ 7] := pluckdigit(Month,0);
       adatetime[ 9] := pluckdigit(Day,1);
       adatetime[10] := pluckdigit(Day,0);
       adatetime[12] := pluckdigit(Hour,1);
       adatetime[13] := pluckdigit(Hour,0);
       adatetime[15] := pluckdigit(Minute,1);
       adatetime[16] := pluckdigit(Minute,0);
       adatetime[18] := pluckdigit(Second,1);
       adatetime[19] := pluckdigit(Second,0);
    end
    else begin
       writeln(output,'getdatetime: invalid time!');
       halt;
    end
  end;
{
   Sun compiler method:
   date(adatetime,'%Y/%m/%d %H:%M:%S');
}
end;
(* end module getdatetime version = 1.17; (@ of timegpc.p 2002 Oct 9 *)

(* begin module readdatetime *)
procedure readdatetime (var thefile: text; var adatetime: datetimearray);
(* read the date and time from the file.  It must have this format:
123456789 123456789
         1         
1980/06/09 18:49:11
 *)
(*
2001 Jan 2: thefile is not written to!  Force 4 digit years.
2000 Oct 11: upgraded so that the p2c compiler does not object
to writing out the adatetime; added checks for the date.
*)
var
   index: integer; (* to the udatetime *)
   (* the following is an unpacked date time array, to avoid reading
   into a packed array.  reading into a packed array is not transportable *)
   udatetime: array[1..datetimearraylength] of char;
begin
   for index:=1 to datetimearraylength do read(thefile,udatetime[index]);
   pack(udatetime, 1, adatetime);
   if (adatetime[3]='/') and (adatetime[12]=':') then begin
      writeln(output,'You have an old datetime (only 2 year digits): ');
      for index:=1 to datetimearraylength do write(output,adatetime[index]);
      writeln(output);
      writeln(output,'Convert your database to 4 digit years.');
      halt;
   end;
   (* check the adatetime format.  Note that further checks for the
      other positions in the array could be done to be sure that
      they are numbers.  But this should be pretty good. *)
   if (adatetime[ 5]<>'/') or
      (adatetime[ 8]<>'/') or
      (adatetime[14]<>':') or
      (adatetime[17]<>':')
   then begin
      writeln(output,'readdatetime: bad date time read:');
      for index:=1 to datetimearraylength do write(output,adatetime[index]);
      writeln(output);
      halt
   end;
end;
(* end module readdatetime version = 1.17; (@ of timegpc.p 2002 Oct 9 *)

(* begin module writedatetime *)
procedure writedatetime(var thefile: text; adatetime: datetimearray);
(* expand the date and time out and print in the file *)
var
      index: integer; (* index of datetime *)
begin
      for index:=1 to datetimearraylength do write(thefile,adatetime[index])
end;
(* end module writedatetime version = 1.17; (@ of timegpc.p 2002 Oct 9 *)

(* begin module timeseed *)    
(* Read the computer date and time.  Reverse the order of the digits and put
a decimal point in front.  This gives a fraction between zero and one that
varies quite quickly, and is always unique (if the computer has sufficient
accuracy).  It is to be used as a seed to a random number generator.  This
has the nice property that the seed changes every second and does not repeat
for thousands of years!  *)
procedure addtoseed(var seed, power: real; c: char);
(* add the digit represented by c to the seed at the power position *)
var
      n: integer; (* the character represented by c *)
begin (* addtoseed *)
      power := power/10;
{
writeln(output,'addtoseed, c = ',c);
writeln(output,'addtoseed, ord(c) = ',ord(c));
}
   n := ord(c) - ord('0');
   if (n < 0) or (n > 9) then begin
      writeln(output,'timeseed: error in datetime');
      writeln(output,'it contains "',c,'" which is not a number.');
      writeln(output,'The getdatetime routine must be fixed.');
      halt;
   end;
   seed := seed + power*n
end; (* addtoseed *)

procedure makeseed(adatetime: datetimearray; var seed: real);
(* convert adatetime to a real number in seed, reversed order
Here is the standard adatetime format:
123456789 123456789
         1         
1980/06/09 18:49:11
*)
var
   power: real; (* a digit of the seed such as 0.01 *)
begin
   seed := 0.0;
   power := 1.0;
   addtoseed(seed, power, adatetime[19]);
   addtoseed(seed, power, adatetime[18]);
   (* : *)
   addtoseed(seed, power, adatetime[16]);
   addtoseed(seed, power, adatetime[15]);
   (* : *)
   addtoseed(seed, power, adatetime[13]);
   addtoseed(seed, power, adatetime[12]);
   (*   *)
   addtoseed(seed, power, adatetime[10]);
   addtoseed(seed, power, adatetime[ 9]);
   (* / *)
   addtoseed(seed, power, adatetime[ 7]);
   addtoseed(seed, power, adatetime[ 6]);
   (* / *)
   addtoseed(seed, power, adatetime[ 4]);
   addtoseed(seed, power, adatetime[ 3]);
   addtoseed(seed, power, adatetime[ 2]);
   addtoseed(seed, power, adatetime[ 1]);
end;

procedure orderseed(adatetime: datetimearray; var seed: real);
(* convert adatetime to a real number in seed, normal order *)
var
   power: real; (* a digit of the seed such as 0.01 *)
begin
   seed := 0.0;
   power := 1.0;
   addtoseed(seed, power, adatetime[ 3]);
   addtoseed(seed, power, adatetime[ 4]);
   addtoseed(seed, power, adatetime[ 6]);
   addtoseed(seed, power, adatetime[ 7]);
   (* / *)
   addtoseed(seed, power, adatetime[ 9]);
   addtoseed(seed, power, adatetime[10]);
   (* / *)
   addtoseed(seed, power, adatetime[12]);
   addtoseed(seed, power, adatetime[13]);
   (*   *)
   addtoseed(seed, power, adatetime[15]);
   addtoseed(seed, power, adatetime[16]);
   (* : *)
   addtoseed(seed, power, adatetime[18]);
   addtoseed(seed, power, adatetime[19]);
end;

procedure timeseed(var seed: real);
(* read the computer date and time.  reverse the order of the digits
and put a decimal point in front.  this gives a fraction between
zero and one that varies quite quickly, and is always unique (if the
computer has sufficient accuracy).  it is to be used as a seed to
a random number generator. *)
var
   adatetime: datetimearray; (* a date and time *)
begin (* timeseed *)
   getdatetime(adatetime);
{
writeln(output,'timeseed: adatetime: ',adatetime);
}
   makeseed(adatetime, seed);
end; (* timeseed *)
(* end module timeseed version = 1.17; (@ of timegpc.p 2002 Oct 9 *)
 
(*[[*)
(* begin module limitdate *)
procedure limitdate(a,b,c,d: char; limitdatetime: datetimearray);
(* test whether the current time is before the limit.
If it is later, halt the program *)
var
   adatetime: datetimearray; (* a date and time *)
   Dday: real; (* the critical day *)
   now: real;  (* this very moment *)
begin
   getdatetime(adatetime);
{
writeln(output,'adatetime:',adatetime);
writeln(output,'adatetime[1]: ', adatetime[1]);
writeln(output,'adatetime[2]: ', adatetime[2]);
writeln(output,'adatetime[3]: ', adatetime[3]);
writeln(output,'adatetime[4]: ', adatetime[4]);
writeln(output,'adatetime[5]: ', adatetime[5]);
}

   orderseed(adatetime, now);

   if
      (limitdatetime[1] <> ' ') or
      (limitdatetime[2] <> ' ') or
      (limitdatetime[3] <> ' ') or
      (limitdatetime[4] <> ' ') then halt;

   limitdatetime[1] := a;
   limitdatetime[2] := b;
   limitdatetime[3] := c;
   limitdatetime[4] := d;

   orderseed(limitdatetime, Dday);

{
   writeln(output,'now:  ',now:20:10);
   writeln(output,'Dday: ',Dday:20:10);
}
   if now > Dday then begin
       writeln(output,'This program expired on ',limitdatetime);
       writeln(output,'See: https://alum.mit.edu/www/toms/walker/contacts.html');
       halt
   end
end;
(* end module limitdate version = 1.17; (@ of timegpc.p 2002 Oct 9 *)
(*]]*)

(* ************************************************************************ *)
(* end module package.datetime version = 1.17; (@ of timegpc.p 2002 Oct 9 *)

(* 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 = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module package.getpiece *)
(* ************************************************************************ *)
(* begin module package.brpiece *)
(* ************************************************************************ *)
(* begin module book.basis *)
(* procedures needed for book manipulations *)

(* get procedures should be used for all linked lists of records *)

procedure getline(var l: lineptr);
(* obtain a line from the free line list or by making a new one *)
begin
      if freeline<>nil
         then begin
            l:=freeline;
            freeline:=freeline^.next
         end
         else new(l);
      l^.length:=0;
      l^.next:=nil
end;

procedure getdna(var l: dnaptr);
begin
      if freedna<>nil
         then begin
            l:=freedna;
            freedna:=freedna^.next
         end
         else new(l);
      l^.length:=0;
      l^.next:=nil
end;

(* clear procedures should be called each time the records are no longer needed
         failure to do this may result in a stack overflow. *)

procedure clearline(var l: lineptr);
(* return a line to the free line list *)
var   lptr: lineptr;
begin
      if l<>nil then begin
         lptr:=l;
         l:=l^.next;
         lptr^.next:=freeline;
         freeline:=lptr
      end
end;

procedure writeline(var afile: text; l: lineptr;
                        carriagereturn: boolean);
(* write a line to a file, with carriage return if
carriagereturn is true. *)
var
   index: integer; (* index to characters in l *)
begin
   with l^ do begin
      for index := 1 to length
      do write(afile, letters[index]);
   end;
   if carriagereturn then writeln(afile);
end;

procedure showfreedna;
(* show the freedna list *)
var
   counter: integer; (* count of freedna list *)
   l: dnaptr; (* pointer into freedna list *)
begin
   l := freedna;
   counter := 0;
   while l <> nil do begin
      counter := succ(counter);
      write(output,counter:1);
      write(output, ', length = ',l^.length:1);
{
This is illegal according to gpc because one cannot
write a pointer to a text file.  It can be unearthed
for debugging.
      write(output, ', pointer id: ',l:1);
}
      writeln(output);
      l := l^.next
   end;
end;

procedure cleardna(var l: dnaptr);
var   lptr: dnaptr;
begin
      if l<>nil then begin
         lptr:=l;
         l:=l^.next;
         lptr^.next:=freedna;
         freedna:=lptr
      end
end;

procedure clearheader(var h: header);
(* clear the header h (remove lines to free storage) *)
begin
      with h do begin
         clearline(fulnam);
         while note<>nil do clearline(note)
      end
end;

procedure clearpiece(var p: pieceptr);
(* clear the dna of the piece *)
begin
      while p^.dna<>nil do cleardna(p^.dna);
      clearheader(p^.key.hea)
end;

function chartobase(ch:char):base;
(* convert a character into a base *)
begin
      case ch of
         'a': chartobase:=a;
         'c': chartobase:=c;
         'g': chartobase:=g;
         't': chartobase:=t
      end
end;

function basetochar(ba:base):char;
(* convert a base into a character *)
begin
      case ba of
         a: basetochar:='a';
         c: basetochar:='c';
         g: basetochar:='g';
         t: basetochar:='t';
      end
end;

function complement(ba:base):base;
(* take the complement of ba *)
begin
      case ba of
         a: complement:=t;
         c: complement:=g;
         g: complement:=c;
         t: complement:=a;
      end
end;

function chomplement(b: char): char;
(* create the character complement of base b.  I must be getting hungry! *)
begin
  chomplement := basetochar(complement(chartobase(b)));
end;

function pietoint(p: integer; pie: pieceptr): integer;
(* p is a coordinate on the piece.
   we want to transform p into a number
   from 1 to n: an internal coordinate system for
   easy manipulation of piece coordinates *)
var   i: integer; (* an intermediate value *)
begin
      with pie^.key do begin
         case piedir of
            plus:  if p>=piebeg
                   then i:=p-piebeg+1
                   else i:=(p-coobeg)+(cooend-piebeg)+2;
            minus: if p<=piebeg
                   then i:=piebeg-p+1
                   else i:=(cooend-p)+(piebeg-coobeg)+2
         end;
         pietoint:=i
      end
end;

function inttopie(i: integer; pie: pieceptr):integer;
(* i is in the range 1 to some maximum.  it is an internal coordinate
   system for the program.  we want to do a
   coordinate transformation to obtain
   a value in the range of the piece called pie:
   i=1 corresponds to piebeg and
   i=its maximum corresponds to pieend *)
var   p: integer; (* an intermediate value *)
begin
      with pie^.key do begin
         case piedir of
            plus: begin
               p:=piebeg+(i-1);
               if p>cooend
                  then if coocon=circular
                     then p:=p-(cooend-coobeg+1)
            end;
            minus: begin
               p:=piebeg-(i-1);
               if p<coobeg
                  then if coocon=circular
                     then p:=p+(cooend-coobeg+1)
            end
         end;
         inttopie:=p
      end
end;

function piecelength(pie: pieceptr): integer;
(* return the length of the dna in pie *)
begin
      piecelength:=pietoint(pie^.key.pieend,pie)
end;

(* end module book.basis version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.getto *)
function getto(var thefile: text; var theline: integer; ch: chset): char;
(* search the file for a character in the first line which is a
   member of the set ch.
Note:  on 1999 March 10 the definition of this function was cleaned
up.  Instead of putting thefile on the line AFTER the charcter ch
has been found, it puts thefile ON the line.  Other routines like
brdna and brpiece have to move to the next line themselves.  This makes
getto give the OBJECT.  *)
var
   achar: char; (* a character in thefile *)
   done: boolean; (* done finding achar *)
begin
   achar:=' ';
   done := false;
   while not done do begin
      if eof(thefile)
      then done := true
      else begin
         achar := thefile^;
         if achar in ch
         then done := true
         else begin
            readln(thefile);
            theline := succ(theline)
         end
      end
   end;
   if (achar in ch) then getto:=achar
                    else getto:=' '
{ The old method -
      while (not(achar in ch)) and (not eof(thefile))
         do begin
            readln(thefile,achar);
            theline := succ(theline)
         end;
   if (achar in ch) then getto:=achar
                    else getto:=' '
}
end;
(* end module book.getto version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.skipstar *)
procedure skipstar(var thefile: text);
(* skip start of line (or star = '*'). *)
begin (* skipstar *)
   if eof(thefile) then begin
      writeln(output,' procedure skipstar: end of book found');
      halt
   end
   else begin
      if thefile^ <> '*' then begin
         writeln(output,' procedure skipstar: bad book');
         writeln(output,' "*" expected as first character on the line, but "',
                        thefile^,'" was found');
         halt
      end;
      get(thefile); (* skip the star *)
      if thefile^ <> ' ' then begin
         writeln(output,' procedure skipstar: bad book');
         writeln(output,' "* " expected on a line but "*',
                        thefile^,'" was found');
         halt
      end;
      get(thefile) (* skip the blank *)
   end
end; (* skipstar *)
(* end module book.skipstar version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.brreanum *)
procedure brreanum(var thefile: text; var theline: integer; var reanum: real);
(* read a real number from the file *)
begin
      skipstar(thefile);
      readln(thefile,reanum);
      theline := succ(theline)
end;
(* end module book.brreanum version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.brnumber *)
procedure brnumber(var thefile: text; var theline: integer; var num: integer);
(* read a number from the file *)
begin
      skipstar(thefile);
      readln(thefile,num);
      theline := succ(theline)
end;
(* end module book.brnumber version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.brname *)
procedure brname(var thefile: text; var theline: integer; var nam: name);
(* read a name from the file *)
var   i: integer; (* an index to the name *)
      c: char; (* a character read *)
begin (* brname *)
      skipstar(thefile);
      with nam do begin
         length:=0;
         repeat
            length:=succ(length);
            read(thefile,c);
            letters[length] := c
         until (eoln(thefile)) or
               (length>=namelength) or
               (letters[length]=' ');
         if letters[length]=' ' then length:=length-1;
         if length<namelength
            then for i:=length+1 to namelength do letters[i]:=' '
      end;
      readln(thefile);
      theline := succ(theline)
end; (* brname *)
(* end module book.brname version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.brline *)
procedure brline(var thefile: text; var theline: integer; var l: lineptr);
(* read a line from the file *)
var
      i: integer;
      acharacter: char;
begin
      skipstar(thefile);
      i:=0;
      while (not eoln(thefile)) do begin
         i:=succ(i);
         read(thefile,acharacter);
         l^.letters[i]:=acharacter
      end;
      l^.length:=i;
      l^.next:=nil;
      readln(thefile);
      theline := succ(theline)
end;
(* end module book.brline version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.brdirect *)
procedure brdirect(var thefile: text; var theline: integer; var direct: direction);
(* read a direction *)
var   ch: char;
begin
      skipstar(thefile);
      readln(thefile,ch);
      theline := succ(theline);
      if ch='+' then direct:=plus
                else direct:=minus
end;
(* end module book.brdirect version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.brconfig *)
procedure brconfig(var thefile: text; var theline: integer; var config: configuration);
(* read a configuration *)
var   ch: char;
begin
      skipstar(thefile);
      readln(thefile,ch);
      theline := succ(theline);
      if ch='l' then config:=linear
                else config:=circular
end;
(* end module book.brconfig version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.brnotenumber *)
procedure brnotenumber(var thefile: text; var theline: integer; var note: lineptr);
(* book note reading to obtain the number of the object.
the procedure returns the value of the number as a global.
(this is not such a good practice, but we are stuck with it for now.) *)
begin (* brnotenumber *)
      note:=nil;
      numbered := false;
      number := 0; (* force number to zero if there
         is no number at all *)
      (* the next character is n or * depending on whether there are notes *)
      if thefile^ = 'n' then begin
         readln(thefile);
         theline := succ(theline);
         if thefile^ <> 'n' then begin
            skipstar(thefile);
            if not eoln(thefile) then begin
               if thefile^ = '#' then begin
                  numbered := true;
                  get(thefile); (* move past the number symbol *)
                  read(thefile,number);
               end
            end;
            repeat
               readln(thefile);
               theline := succ(theline)
            until thefile^ = 'n';
            readln(thefile);
            theline := succ(theline)
         end
         else begin
            readln(thefile);
            theline := succ(theline)
         end
      end
end; (* brnotenumber *)
(* end module book.brnotenumber version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.brnote *)
procedure brnote(var thefile: text; var theline: integer; var note: lineptr);
(* read note key *)
var
      newnote: lineptr; (* the new note *)
      previousnote: lineptr; (* the last line of the notes *)
begin (* brnote *)
      note:=nil;
      if thefile^ = 'n' then begin (* enter note *)
         readln(thefile);
         theline := succ(theline);
         if thefile^ <> 'n' then begin (* abort null note (n/n) *)
            getline(note);
            newnote:=note;
            while thefile^ <> 'n' do begin (* wait until end of note *)
               brline(thefile,theline,newnote);
               previousnote:=newnote;
               (* get next note *)
               getline(newnote^.next);
               newnote:=newnote^.next;
            end;
            (* last note was not used, so: *)
            clearline(newnote);
            previousnote^.next:=nil;
            readln(thefile);
            theline := succ(theline);
         end
         else begin
            readln(thefile);
            theline := succ(theline);
         end;
      end
end; (* brnote *)
(* end module book.brnote version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.brheader *)
procedure brheader(var thefile: text; var theline: integer; var hea: header);
(* read the header of a key. *)
begin
      with hea do begin
         readln(thefile); (* move past the object name - new definition 1999 Mar 13 *)
         theline := succ(theline);
{bbb}
         (* read key name *)
         brname(thefile,theline,keynam);

         (* read full name *)
         getline(fulnam);
         brline(thefile,theline,fulnam);

         (* read note key *)
         if readnumber then brnotenumber(thefile,theline,note)
                       else brnote(thefile,theline,note)
      end
end;
(* end module book.brheader version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.copyheader *)
procedure copyheader(fromhea: header; var tohea: header);
(* copy the header fromhea into tohea.  Note that the
linked objects are NOT copied, but merely pointed to. *)
begin
   tohea.keynam.letters := fromhea.keynam.letters;
   tohea.keynam.length  := fromhea.keynam.length;
   tohea.note           := fromhea.note;
   tohea.fulnam         := fromhea.fulnam;
end;
(* end module book.copyheader version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.brpiekey *)
procedure brpiekey(var thefile: text; var theline: integer; var pie: piekey);
(* read piece key, track the line number *)
begin
      with pie do begin
         brheader(thefile,theline,hea);
         brreanum(thefile,theline,mapbeg);
         brconfig(thefile,theline,coocon);
         brdirect(thefile,theline,coodir);
         brnumber(thefile,theline,coobeg);
         brnumber(thefile,theline,cooend);
         brconfig(thefile,theline,piecon);
         brdirect(thefile,theline,piedir);
         brnumber(thefile,theline,piebeg);
         brnumber(thefile,theline,pieend);
      end
end;
(* end module book.brpiekey version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.brdna *)
procedure brdna(var thefile: text; var theline: integer; var dna: dnaptr);
(* read in dna from thefile, track the line *)
(* note: if the dna were circularized, by linking the last dnastring
to the first, then the cleardna routine could not clear properly,
and would loop forever... there is no reason to do that, since a simple
mod function will allow one to access the circle. *)
var
      ch: char;
      workdna: dnaptr;
begin
      getdna(dna);
      workdna:=dna;
      ch:=getto(thefile,theline,['d']);
      readln(thefile);
      theline := succ(theline);
      read(thefile,ch); (* skipstar *)
      while (ch = '*') do
      begin
         read(thefile,ch); (* skip blank *)
         repeat
            read(thefile,ch);
            if ch in ['a','c','g','t'] then begin
               if workdna^.length=dnamax then begin
                  getdna(workdna^.next);
                  workdna:=workdna^.next
               end;
               workdna^.length:=succ(workdna^.length);
               workdna^.part[workdna^.length]:=chartobase(ch)
            end
         until eoln(thefile);
         readln(thefile); (* go to next line *)
         theline := succ(theline);
         read(thefile,ch); (* ch is either '*' or 'd' *)
      end;
      readln(thefile); (* read past the d *)
      theline := succ(theline);
end;
(* end module book.brdna version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.brpiece *)
procedure brpiece(var thefile: text; var theline: integer; var pie: pieceptr);
(* read in a piece, change theline to reflect the lines traversed *)
begin
{
   readln(thefile); (* move past the word 'piece' - new definition 1999 Mar 13 *)
   theline := succ(theline); (* BUG: was below! *)
bbb}
   brpiekey(thefile,theline,pie^.key);
   if numbered or (not skipunnum)
   then brdna(thefile,theline,pie^.dna);
   readln(thefile); (* move past the word 'piece' - new definition 1999 Mar 13 *)
   theline := succ(theline);
end;
(* end module book.brpiece version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.brinit *)
procedure brinit(var book: text; var theline: integer);
(* check that the book is ok to read, and
   set up the global variables for br routines *)
begin (* brinit *)
      (* halt if the book is bad (first word is 'halt') or the first
         character is not * *)
      reset(book);
      if not eof(book) then begin
         (* check for the date line *)
         if book^ <> '*' then begin
            if book^ <> 'h'
            then writeln(output, ' this is not the first line of a book:')
            else writeln(output, ' bad book:');
            write(output, ' ');

            while not (eoln(book) or eof(book)) do begin
               write(output, book^);
               get(book)
            end;
            writeln(output);
            halt
         end
      end
      else begin
         writeln(output, ' book is empty');
         halt
      end;

      (* initialize free storage *)
      freeline:=nil;
      freedna:=nil;

      readnumber:=true; (* usually we read in numbers for items *)
      number:=0; (* arbitrary value *)
      numbered:=false; (* the piece has no number (none yet read in) *)
      skipunnum:=false;
   theline := 1;
end; (* brinit *)
(* end module book.brinit version = 7.51; {of delmod.p 2000 Jul 25} *)

(* ************************************************************************ *)
(* end module package.brpiece version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.getpiece *)
procedure getpiece(var thefile: text; var theline: integer; var pie: pieceptr);
(* move to and read in the next piece in the book *)
var   ch: char;
begin
   ch:=getto(thefile,theline,['p']); (* get to the next p(iece) in the book *)
   if ch<>' ' then begin
      brpiece(thefile,theline,pie);
{
1999 june 2: removed this:
      ch:=getto(thefile,theline,['p']); (* read to end of p *)
}
{
bbb - now done in brpiece
      readln(thefile); (* read past piece *)
      theline := succ(theline);
}
   end
   else clearpiece(pie);
end;
(* end module book.getpiece version = 7.51; {of delmod.p 2000 Jul 25} *)

(* ************************************************************************ *)
(* end module package.getpiece version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module book.getbase *)
function getbase(position: integer; pie: pieceptr):base;
(* Get a base from the position (internal coordinates) of the
   piece.  Protection is made against positions outside the piece.
In the case of circles it would be convenient to wrap around when
requests are off the end.  So the routine will do a modular
wrap for positions outside the range 1 to the length.
This is a new feature as of 2000 March 22.
*)
var
   workdna: dnaptr; (* pointer to the dna part of pie *)
   p: integer; (* current count of bases into the workdna *)
   spot: integer; (* the last base of the dna part *)
   thelength: integer; (* the length of the piece *)
begin
{
writeln(output,'NEW getbase: position=',position:1,'^^^^^^^^^^^^^^^^^^^^');
}
   (* handle cases of position out of range by circular wrapping *)
   thelength := piecelength(pie);
   while position < 1         do position := position + thelength;
   while position > thelength do position := position - thelength;

   workdna:=pie^.dna;
   p:=workdna^.length;
   while position > p do begin
{
writeln(output,' workdna^.length=',workdna^.length:1);
}
      workdna := workdna^.next;
      if workdna = nil then begin
        writeln(output,'error in function getbase!');
        halt
      end;
      p := p + workdna^.length;
   end;
{
writeln(output,'p=',p:1);
}
   if workdna = nil then begin
      writeln(output,'error in getbase: request off end of piece');
      halt
   end
   else begin
      spot := workdna^.length - (p-position);
{
writeln(output,'spot=',spot:1);
showdnasegment(output,workdna, spot);
}
      if (spot <= 0) then begin
         writeln(output,'error in getbase, spot (= ',spot:1, ') must be positive');
         halt
      end;
      if (spot > workdna^.length) then begin
         writeln(output,'error in getbase, spot (=',spot:1,
                        ') must be less than length (=',workdna^.length:1,')');
         halt
      end;
{
writeln(output,'base = ', workdna^.part[spot]);
}
      getbase:=workdna^.part[spot]
   end
end;
(* end module book.getbase version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module package.numbar *)
(* ************************************************************************ *)
(* begin module numberdigit *)
function numberdigit(number, logplace:integer): char;
(* return the digit at the place value ('logplace') position of number.
example:
      numberdigit(13625, 3) = 3
      numberdigit(13625, 4) = 1
2000 July 30 'myabsolute' replaced 'absolute', which
is apparently a keyword for GPC.  The name is kept
to keep the code looking similar to its origin.
*)
var
      place: integer; (* the exponent of logplace *)
      count: integer; (* used to make place *)
      myabsolute: integer; (* the absolute value of number *)
      acharacter: char; (* the character to be returned *)
procedure digit;
(* extract a digit at the place position *)
var
      tenplace: integer; (* ten times place *)
      z: integer; (* an intermediate value *)
      d: integer; (* the digit extracted *)
begin (* digit *)
      tenplace:=10*place;
      z:=myabsolute-((myabsolute div tenplace)*tenplace);
      if place = 1
         then d:=z
         else d:= z div place;
      case d of
         0: acharacter:='0';
         1: acharacter:='1';
         2: acharacter:='2';
         3: acharacter:='3';
         4: acharacter:='4';
         5: acharacter:='5';
         6: acharacter:='6';
         7: acharacter:='7';
         8: acharacter:='8';
         9: acharacter:='9';
      end
end; (* digit *)
procedure sign;
(* put a negative sign out or a positive sign *)
begin (* sign *)
      if number <0 then acharacter:='-'
                   else acharacter:='+'
end; (* sign *)
begin (* numberdigit *)
      place:=1;
      for count:=1 to logplace do place:=10*place;

      if number=0 then begin
         if place=1 then acharacter:='0'
                    else acharacter:=' '
      end
      else begin
         myabsolute:=abs(number);
         if myabsolute < (place div 10)
            then acharacter:=' '
            else if myabsolute >= place
                    then digit
                    else sign
      end;
      numberdigit:=acharacter
end; (* numberdigit *)
(* end module numberdigit version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module numbersize *)
function numbersize(n: integer):integer;
(* calculate amount of space to be reserved for the integer n *)
const ln10 = 2.30259; (* natural log of 10 - for conversion to log base 10 *)
      epsilon = 0.00001; (* a small number to correct log base 10 errors *)
var
   size: integer; (* intermediate result *)
begin (* numbersize *)
   if n = 0
   then numbersize:=1
   else begin
      size:=trunc(ln(abs(n))/ln10 + epsilon) + 1;
      (* the 1 is for the last digit *)
      (* the epsilon assures that we do not lose a place due to
         roundoff.  eg, sometimes log base 10 of 10 would be 0.9999
         instead of 1, and we would not do it right...  note: this will
         fail for very large numbers on the order of 1/epsilon. *)
      if n < 0 then size := succ(size);  (* account for minus sign *)
      numbersize := size;
   end
end; (* numbersize *)
(* end module numbersize version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module numberbar *)
function firstlastmax(firstnumber, lastnumber: integer): integer;
(* compute the sizes of firstnumber and lastnumber (including + or -
sign) and then determine which number is larger *)
var
   firstlines: integer; (* number of lines needed for firstumber *)
   lastlines: integer; (* number of lines needed for lastnumber *)
begin
   firstlines := numbersize(firstnumber);
   if firstnumber > 0
   then firstlines := firstlines + 1; (* add one more for + sign *)
   lastlines := numbersize(lastnumber);
   if lastnumber > 0
   then lastlines := lastlines + 1; (* add one more for + sign *)
   if firstlines > lastlines
   then firstlastmax := firstlines
   else firstlastmax := lastlines;
end;

procedure numberbar(var afile: text; spaces, firstnumber, lastnumber: integer;
                    var linesused: integer);
(* write a bar of numbers to a file, with several spaces before.
   the number of lines used is returned *)
var
   logplace: integer; (* the log of the digit being looked at *)
   number: integer; (* the current number being written *)
   spacecount: integer; (* count of spaces *)
begin
{ 2000 June 24:  This code was not sufficient to deal with the sign
correctly.  The numbersize routine now does *not* give the + sign
(which makes it useful for other purposes) so we have to account
for it here now.
   if abs(firstnumber) > abs(lastnumber)
      then linesused:= numbersize(firstnumber)
      else linesused:= numbersize(lastnumber);
}
   linesused := firstlastmax(firstnumber, lastnumber);
{
writeln(output,'numberbar says linesused = ',linesused:1);
      for logplace:=linesused-1 downto 0 do begin
1999 July 15: this is changed to linesused since numbersize now
accounts for the sign:
   for logplace := linesused downto 0 do begin
2000 June 24:  back to the old code ...
}
   for logplace := linesused-1 downto 0 do begin
      for spacecount:=1 to spaces do write(afile,' ');
      for number:=firstnumber to lastnumber
         do write(afile,numberdigit(number,logplace));
      writeln(afile)
   end
end;
(* end module numberbar version = 5.67; (@ of prgmod.p 2017 Sep 29 *)
(* ************************************************************************ *)
(* end module package.numbar version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module book.stepbase *)
function stepbase(startdna: dnaptr; var dna: dnaptr; var d: dnarange): base;
(* advance d by one base in dna and then return the base at the new d.
   (this means that one should initialize d to zero)
   if we go past the last base, we restart at startdna.
   note: d is not the number of the base... it is used as a
   record for stepbase.  do not mess with it, and do not use it to find
   out what base you are on.  use a separate counter.  *)
begin
      if (d=dnamax) or (d=dna^.length) then begin
         d:=1;
         dna:=dna^.next;
         if dna=nil then dna:=startdna
      end
      else d:=succ(d);
      stepbase:=dna^.part[d]
end;
(* end module book.stepbase version = 7.51; {of delmod.p 2000 Jul 25} *)

(* begin module nextbase *)
procedure initnextbase(var book: text; var pie: pieceptr;
                       var lastbase, endofbook: boolean;
                       var theline: integer);
(* initialize variables for function nextbase.
   book is the book to be read,
   pie is the piece,
   lastbase is the flag that is true when we are at the
   last base of a piece,
   and endofbook is true if we are at the end of the book (see nextbase).
   theline records the current line number in the book. *)
begin
      brinit(book, theline);

      new(pie);
      with pie^ do begin
         with key.hea do begin
            fulnam:=nil;
            note:=nil
         end;
         dna:=nil
      end;

      lastbase:=true; (* this will trigger reading of the next piece *)
      if eof(book) then endofbook:=true
                   else endofbook:=false
end;

function nextbase(var book: text;  (* the book being read *)
                  var theline: integer; (* current line number of the book *)
(* the next variables can be ignored *)
                  var pie: pieceptr; (* the piece *)
                  var dnalink: dnaptr; (* the current link we are on *)
                  var dnalinkspot: dnarange; (* the spot in the dnalink *)
(* these are useful to the general user: *)
                  var dnaspot, (* integer in 1 to length, which base this is *)
                      length: integer; (* length of this piece *)
                  var lastbase, (* true if the base was the last one on
                                   the piece. *)
                      endofbook: boolean) (* true when we have reached
                                             the end of the book *)
                  : base;
(* the user simply declares variables for
   book, pie, dnalink, dnalinkspot (of the appropriate type)
note: you can convert the valuespot to published coordinates by
      pubcoords:= inttopie(dnaspot,pie);
warning: if the end of the book has been reached, then endofbook
is true, but the value returned by the function has no meaning.
*)
begin
   if not endofbook then begin
      if not lastbase then begin
         nextbase:=stepbase(pie^.dna,dnalink,dnalinkspot);
         dnaspot:=succ(dnaspot);
         if dnaspot = length then lastbase:=true
      end
      else begin (* we are at the last base of the previous piece *)
         clearpiece(pie);
         getpiece(book,theline,pie);
         if not eof(book) then begin
            dnalink:=pie^.dna;
            dnalinkspot:=0;
            dnaspot:=0;
            length:=piecelength(pie);
            lastbase:=false;
            endofbook:=false;
            nextbase:=nextbase(book,theline,pie,dnalink,dnalinkspot,
                               dnaspot,length,lastbase,endofbook)
         end
         else begin
            endofbook:=true; (* we have reached the end of the book *)
            lastbase:=false; (* we are no longer at the last base *)
            nextbase:=a (* a fake value *)
         end
      end
   end
end;
(* end module nextbase version = 7.51; {of delmod.p 2000 Jul 25} *)

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

(* 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.
As of 2010 Dec 04 there is a previous pointer that
allows proper removal of the linked list using disposestring.
This clearstring routine is for the initial clearing
of the variables. *)
begin (* clearstring *)
   with ribbon do begin
      emptystring(ribbon);
      previous := nil;
      next := nil;
   end
end; (* clearstring *)
(* ---- *)
procedure disposestring(var ribbon: stringptr);
(* remove the linked list from the string in revere order *)
var
   t: stringptr; (* a link in the string *)
begin
   t := ribbon;
   (* find the end *)
   while t^.next <> nil do t := t^.next;
   (* move backwards and dispose links *)
   while t^.previous <> nil do begin
      t := t^.previous;
      dispose(t^.next);
   end;
   dispose(t);
end; (* disposestring *)
(* ---- *)
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.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module detabstring *)
procedure detabstring(var s: string);
(* Tabs are converted to blanks.  This allows the tab to be a special "solid"
kind of blank, but the string written won't vary with position on the line
depending on the tabstops. *)
const
   tabcharacter = 9; (* the ordinal of the tab character *)
var
   c: char; (* a character write out *)
   i: integer; (* index to the string s *)
begin
   with s do for i := 1 to length do begin
      c := letters[i];
{
for testing:
      if ord(c) = tabcharacter then c := 'T'; (* tab converted to blank *)
}
      if ord(c) = tabcharacter then c := ' '; (* tab converted to blank *)
      letters[i] := c
   end;
end;
(* end module detabstring version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module equalstring *)
function equalstring(a, b: string): boolean;
(* Test for equality between two strings at current positions.
NOTE:  A compiler bug results if one directly tests this way:
   if thedefinition^.nametag = aname
The reason is completely not clear!  I showed that the parts of the
strings were identical, but the whole was not by this test.
For this reason it is *critical to test strings with equalstring.
*)
var   index: integer; (* index to both strings *)
      equal: boolean; (* are letters in a and b the same? *)
begin (* equalstring *)
      if a.length = b.length
      then begin
         index := 1;
         repeat
            equal := (a.letters[index] = b.letters[index]);
            index := succ(index)
         until (not equal) or (index > a.length);
         equalstring := equal
      end
      else equalstring := false
end; (* equalstring *)
(* end module equalstring version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* 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 = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module grabtoken *)
procedure grabtoken(var thefile: text; var thestring: string);
(* skip any blanks and then grab the next token from the file *)
var
   c: char; (* a character in thefile *)
   done: boolean; (* done finding the name *)
begin
   skipblanks(thefile);
   done := false;
   with thestring do begin
      length := 0;
      while not done do begin
         if eoln(thefile)
         then done := true
         else begin
            read(thefile,c);
            if c = ' '
            then done := true
            else begin
               length := succ(length);
               letters[length] := c;
            end
         end
      end
   end
end;
(* end module grabtoken version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module readquotestring *)
procedure readquotestring(var afile: text; var s: string);
(* read the quoted string from afile, remove the quotes.  Trailing
blanks are converted to tab characters. *)
const
   tabcharacter = 9; (* the ordinal of the tab character *)
var
   c: char; (* a character read *)
   i: integer; (* index to the string s *)
begin
   emptystring(s);
   skipblanks(afile);
   with s do begin
      read(afile,c);
      if c <> '"' then begin
         writeln(output, 'quote string expected but " missing');
         writeln(output, 'character found instead:"',c,'"');
         halt
      end;
      if eoln(afile) then begin
         writeln(output, 'missing end of quote string " string');
         halt
      end;
      repeat
         read(afile,c);
         if c <> '"' then begin
            length := succ(length);
            letters[length] := c;
         end;
      until (c = '"')
            or eoln(afile) or (length = maxstring);
      if length = maxstring then begin
         writeln(output, 'A quote string exceeded ',maxstring:1,
                         ' characters.');
         writeln(output, 'Use a shorter string or increase constant',
                         ' maxstring.');
         halt
      end;
      if c <> '"' then begin
         writeln(output, 'The second " mark of a string is missing.');
         halt
      end;
      (* convert all blanks to tab characters *)
      for i := 1 to length do begin
         if letters[i] = ' '
         then letters[i] := chr(tabcharacter); (* set to tab character *)
      end;
   end;
end;
(* end module readquotestring version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* 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.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module writequotestring *)
procedure writequotestring(var afile: text; s: string);
(* Write the string s to afile, surrounded by double quote marks.  Tabs are
converted to blanks.  This allows the tab to be a special "solid" kind of
blank, but the string written won't vary with position on the line depending
on the tabstops. *)
begin
   detabstring(s);
   write(afile, '"');
   writestring(afile, s);
   write(afile, '"');
end;
(* end module writequotestring version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

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

(* begin module readstringline *)
procedure readstringline(var afile: text; var buffer: string);
(* get a line (as a string) from a file. *)
var   index: integer; (* of buffer *)
begin (* getstring *)
   clearstring(buffer);
   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, 'readstringline: a line exceeds maximum string size (',
                      maxstring:1,')');
      halt
   end;
   buffer.length := index;
   buffer.current := 1;
   readln(afile);
end; (* readstringline *)
(* end module readstringline version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module readheader *)
procedure readheader(var afile: text; ch: char; var theheader: stringptr);
(* Read the header from a file.  Only read lines that begin with ch.
2004 Dec 15: Handle end of file (eof) gracefully. *)
var
   h: stringptr; (* pointer to the riblheader *)
begin
   if eof(afile) then begin
      clearstring(theheader^);
   end
   else begin
      if afile^ = ch then begin
         new(theheader);
         h := theheader;
         while afile^='*' do begin
            readstringline(afile, h^);
            if not eof(afile) then begin
               if afile^='*' then begin
                  new(h^.next);
                  h := h^.next;
               end
               else h^.next := nil;
            end
         end
      end
      else begin
         theheader := nil
      end;
   end;
end;
(* end module readheader version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module readwaveparameters *)
procedure readawaveparameter(var afile: text; var wp: waveparam);
{
                                 cmperbase, cmperbit: real);
}
(* Read one wave parameter from a file. *)
{
2000 Nov 1:  The following experimental code is not implemented:
See the coscurve program
(https://alum.mit.edu/www/toms/delila/coscurve.html) for details
about the conversion from bases to cm.  The code now requires
cm per base and cmperbit.
const
   lover2pi = 1.2160067233; (* L/2pi for L being the length of
       the cosine function from 0 to 2pi *)
var
   multiplier: real; (* factor to multiply by to convert from bases to cm. *)
}
begin
   readln(afile,wp.extreme);
   readln(afile,wp.wavelocation);
   readln(afile,wp.wavebit);
   readln(afile,wp.waveamplitude);
   readln(afile,wp.wavelength);
   if wp.wavelength <= 0.0 then begin
      writeln(output,'wave parameters: wavelength must be positive');
      halt
   end;
   (* one may skip the dash and thickness parameters
      of the last wave definition.  This allows
      backwards compatability, but should not be
      used in general. *)
   if eof(afile)
   then begin
      wp.dashon := 0;
      wp.dashoff := 0;
      wp.dashoffset := 0;
      wp.thickness := 0
   end
   else begin
      (* implement new method to read dash information
         without breaking previous wave parameter files *)
      if afile^ <> 'd'
      then begin (* default to old method *)
         readln(afile,wp.dashon);
         wp.dashoff := wp.dashon;
         wp.dashoffset := 0;
      end
      else begin
         get(afile); (* skip the 'd' *)
         (* reading the parameters directly in cm would require
            that the user compute or guess the values.
            So read in as bases and compute cm.
            Unfortunately the length of a curve is not the simple
            scale factor.  Make the user guess for now.
         *)
         readln(afile,wp.dashon, wp.dashoff, wp.dashoffset)

{
experimental code to account for actual wave length:
         readln(afile, wp.BASEdashon, wp.BASEdashoff, wp.BASEdashoffset);
         multiplier    := 1;
         multiplier    := lover2pi
 * wp.waveamplitude (* in bits *)
 * cmperbit (* converts to cm *)
 / wp.wavelength (* 10.6 bp/turn *)
* cmperbase
;
multiplier    := lover2pi;
multiplier    := 1.0;
multiplier    := 1.0/lover2pi;
         multiplier := lover2pi
                       * wp.waveamplitude (* in bits *)
                       * cmperbit (* converts to cm *)
                       * wp.wavelength (* 10.6 bp/turn *)
                       * cmperbase;
         multiplier := 1.0
         wp.dashon     := multiplier * wp.BASEdashon;
         wp.dashoff    := multiplier * wp.BASEdashoff;
         wp.dashoffset := multiplier * wp.BASEdashoffset;
with wp do begin
   writeln(output, 'cmperbase  = ',cmperbase:5:2);
   writeln(output, 'cmperbit   = ',cmperbit:5:2);
   writeln(output, 'dashon     = ',dashon:5:2);
   writeln(output, 'dashoff    = ',dashoff:5:2);
   writeln(output, 'dashoffset = ',dashoffset:5:2);
   writeln(output, 'waveamplitude   = ',wp.waveamplitude:5:2);
   writeln(output, 'wavelength      = ',wp.wavelength:5:2);
end;
}

      end;
      if eof(afile)
      then wp.thickness := 0
      else readln(afile,wp.thickness);
   end;
end;

procedure readwaveparameters(var afile: text; var w: waveptr);
{
                                 cmperbase, cmperbit: real);
}
(* read from afile the wave parameters w.  The routine is done either at end
of file, when a period ('.') appears or at a blank line.  This makes it
compatable with different reading mechanisms. *)
var
   done: boolean; (* done reading *)
   morethanone: boolean; (* more than one wave? *)
   p: waveptr; (* one of the definitions of a cosine wave *)
procedure waystoend;
(* if end of file, a blank line or a period, consider the job done *)
var
   clear: boolean; (* not eof, so clear to test for comment *)
begin
   if eof(afile) then done := true;
   clear := false;
   if not done (* skip any number of comments *)
   then while (not clear) and (not done) do begin
      if eof(afile) then begin
         done := true;
         clear := true;
      end
      else if afile^ = '*'
           then readln(afile)
           else clear := true
   end;
   if not done then if eoln(afile) then done := true;
   if not done then if afile^='.' then begin
      readln(afile);
      done := true;
   end;
end;
begin
   done := false;
   morethanone := false;
   w := nil;
   waystoend;
   if not done then begin
      new(w);
      p := w;
      while not done do begin
         waystoend;
         if done
         then p^.next := nil
         else begin
            if afile^='*'
            then readln(afile) (* skip any number of comments *)
            else begin
               if morethanone then begin
                  new(p^.next);
                  p := p^.next
               end;
{
               readawaveparameter(afile, p^, cmperbase, cmperbit);
}
               readawaveparameter(afile, p^);
               (* if we ever come back again there will be more than one: *)
               morethanone := true;
            end
         end
      end
   end
   else w := nil;
end;
(* end module readwaveparameters version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module getriblmatrix *)
procedure getriblmatrix(var afile: text; var matrix: ribltypeptr);
(* Get the matrix from a file, with the defining coordinate limits,
followed by the mean and standard deviation and other data.
The entire matrix is read in. *)
const
   clearvalue = 5.0; (* If a large bit position is ever seen (for DNA), we
      KNOW there is a bug in the code! *)
var
   b: base; (* a base in the matrix *)
   l: integer; (* a coordinate in the matrix *)
   thel: integer; (* the l value in the file (should match l) *)

   teststring: string; (* string to test for 'ribl ' at matrix start *) 
   riblstart: string; (* word at the start of the matrix *)

procedure testforend;
(* test for end of file *)
begin
   if eof(afile) then begin
      writeln(output,'part or all of the ribl matrix is missing');
      halt;
   end
end;
procedure skip;
(* skip comment lines *)
begin
   testforend;
   while afile^='*' do begin
     readln(afile);
     testforend
   end
end;
begin
   new(matrix);
   with matrix^ do begin

      (* read name of the matrix *)
      grabtoken(afile, riblstart);
      teststring.letters[1] := 'r'; 
      teststring.letters[2] := 'i';
      teststring.letters[3] := 'b';
      teststring.letters[4] := 'l';
      teststring.length := 4; 
 
      if not equalstring(riblstart, teststring) then begin
         writeln(output,'The ribl matrix must begin with ''ribl "name"''');   
         writequotestring(output,riblstart);
         writeln(output, ' seen instead');
         halt
      end;
 
      skipblanks(afile); (* skip any spaces *)
      readquotestring(afile, matrix^.riblname);
      readln(afile);

      readheader(afile,'*',riblheader);

      readln(afile,frombase,tobase);

      if frombase < minribl then begin
         writeln(output,'Matrix is too large for program.');
         writeln(output,'frombase (=',frombase:1,')');
         writeln(output,'minribl (=',minribl:1,')');
         writeln(output,'Decrease minribl or increase frombase');
         halt
      end;

      if tobase > maxribl then begin
         writeln(output,'Matrix is too large for program.');
         writeln(output,'tobase (=',tobase:1,')');
         writeln(output,'maxribl (=',maxribl:1,')');
         writeln(output,'Increase maxribl or decrease tobase');
         halt
      end;

      (* clear unused matrix for safety *)
      for l := minribl to frombase-1
      do for b := a to t do matrix^.data[b,l] := clearvalue;
      for l := tobase+1 to maxribl
      do for b := a to t do matrix^.data[b,l] := clearvalue;

      for l := frombase to tobase do begin
         testforend;
         for b := a to t do read(afile,matrix^.data[b,l]);
         read(afile,thel);
         if thel <> l then begin
            writeln(output, 'positions in ribl do not match from-to range');
            halt;
         end;
         for b := a to t do read(afile,matrix^.numbers[b,l]);
         readln(afile)
      end;

      skip; readln(afile,mean);
      skip; readln(afile,stdev);
      skip; readln(afile,consensus);
      skip; readln(afile,anticonsensus);
      skip; readln(afile,averageRi);
      skip; readln(afile,n);
      skip; readln(afile,symmetry);
      skip; readln(afile,Ribound);
      skip; readln(afile,Zbound);
      skip; readln(afile,Pbound);
{this is a guess - set the converters to neutral for now
      cmperbase := 1.0;
      cmperbit := 1.0;
      readwaveparameters(afile, waves, cmperbase, cmperbit);
}
      readwaveparameters(afile, waves);
   end;
end;
(* end module getriblmatrix version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

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

(* begin module makewalker.readparameters *)
procedure readparameters(var makewalkerp: text; var p: parameters);
(* read parameters p from makewalkerp *)
var
   parameterversion: real; (* parameter version number *)
begin
   reset(makewalkerp);
   readln(makewalkerp, parameterversion);
   if round(100*parameterversion) < round(100*updateversion) then begin
      writeln(output, 'You have an old parameter file!');
      halt
   end;

   with p do begin
      readln(makewalkerp, rangefrom);
      readln(makewalkerp, rangeto);

      readln(makewalkerp, basesperline);
      readln(makewalkerp, linesperpage);

      readln(makewalkerp, basenumber);
      if basenumber > basesperline - 1 then begin
         writeln(output,'basenumber cannot be > basesperline - 1 =',
                        basesperline:1);
         halt
      end;
      if basenumber < 0 then begin
         writeln(output,'basenumber cannot be < 0');
         halt
      end;

      readln(makewalkerp, linenumber);
      if linenumber > linesperpage -1 then begin
         writeln(output,'linenumber cannot be > linesperpage - 1 =',
                        linesperpage:1);
         halt
      end;
      if linenumber < 0 then begin
         writeln(output,'linenumber cannot be < 0');
         halt
      end;

      readln(makewalkerp, coornumber);

      readln(makewalkerp, pagewidth);
      readln(makewalkerp, pageheight);
      readln(makewalkerp, pagex);
      readln(makewalkerp, pagey);

      readln(makewalkerp, lowerbound);
      if lowerbound > 0.0 then begin
         writeln(output,'lowerbound cannot be > 0.0');
         halt
      end;

(*
      readln(makewalkerp, fractionofline);
      if fractionofline > 1.0 then begin
         writeln(output,'fractionofline cannot be > 1.0');
         halt
      end;
      if fractionofline <= 0.0 then begin
         writeln(output,'fractionofline cannot be <=  0.0');
         halt
      end;
*)
      fractionofline := 1.0;

      readln(makewalkerp, boxes);

      readln(makewalkerp, outofsequence);
      if not (outofsequence in ['i','o']) then begin
         writeln(output,'outofsequence must be either "i" or "o"');
         halt
      end;

   end
end;
(* end module makewalker.readparameters *)

(* begin module makewalker.writeparameters *)
procedure writeparameters(var w: text; p: parameters);
(* write parameters p to w *)
begin
   with p do begin
      writeln(w);
      writeln(w, '% user defined parameters');
      writeln(w, '/rangefrom ', rangefrom:1,' def');
      writeln(w, '/rangeto ', rangeto:1,' def');

      writeln(w, '/basesperline ', basesperline:1,' def');
      writeln(w, '/linesperpage ', linesperpage:1,' def');
      writeln(w, '/basenumber ', basenumber:1,' def');
      writeln(w, '/linenumber ', linenumber:1,' def');
      writeln(w, '/coornumber ', coornumber:1,' def');

      writeln(w, '/pagewidth ', pagewidth:pwid:pdec,' cm def');
      writeln(w, '/pageheight ', pageheight:pwid:pdec,' cm def');
      writeln(w, '/pagex ', pagex:pwid:pdec,' cm def');
      writeln(w, '/pagey ', pagey:pwid:pdec,' cm def');

      writeln(w, '/lowerbound ', lowerbound:pwid:pdec,' def');
      writeln(w, '/fractionofline ', fractionofline:pwid:pdec,' def');

      write(w, '/boxstate ');
      if boxes = 'b'
         then write(w,'true')
         else write(w,'false');
      writeln(w, ' def');

      write(w, '/outofsequence ');
      if outofsequence = 'o'
         then write(w,'true')
         else write(w,'false');
      writeln(w, ' def');

   end
end;
(* end module makewalker.writeparameters *)

(* begin module createheader *)
procedure createheader(var w: text);
(* create the header of the w file *)
begin
rewrite(w);

writeln(w,'%!PS-Adobe-2.0 EPSF-2.0');
writeln(w,'%%Title: makewalker ',version:4:2);
writeln(w,'%%Creator: Tom Schneider');
writeln(w,'%%BoundingBox:',
          ' ',llx:5:1,
          ' ',lly:5:1,
          ' ',urx:5:1,
          ' ',ury:5:1);
writeln(w,'%%Pages: 1');
writeln(w,'%%DocumentFonts:');
writeln(w,'%%EndComments');
writeln(w,'%%EndProlog');

writeln(w,'/llx ',llx:5:1,' def');
writeln(w,'/lly ',lly:5:1,' def');
writeln(w,'/urx ',urx:5:1,' def');
writeln(w,'/ury ',ury:5:1,' def');

writeln(w);
writeln(w,'/cmfactor 72 2.54 div def % defines points -> centimeters');
writeln(w,'/cm { cmfactor mul} def % defines centimeters');
writeln(w);
writeln(w,'/zbound 3 def % defines upper Z score for reporting sites');
writeln(w,'/ribound 0 def % defines lower ribltotal for reporting sites');
writeln(w,'/ribltotal 0 def');
writeln(w,'/Z 0 def');
writeln(w,'% note: the wave phase is not changed when page is redrawn');
writeln(w,'/wavephase 0 def % initial value of phase of cosine wave');
writeln(w,'/doingwave true def % whether or not the wave is drawn');
writeln(w,'/printing false def % whether to print all the time or not');
writeln(w,'/forcedisplay true def');
writeln(w,'/DoErasePage true def % whether to erase the page');
writeln(w,'/doreport true def % whether to report to output');
writeln(w);
writeln(w,'gsave');
end;
(* end module createheader *)

(* begin module createender *)
procedure createender(var makewalkerp, w: text);
(* create the ender of the w file,
perhaps using makewalkerp for final instructions *)
begin
   (* obtain any other user commands from the makewalkerp file: *)
   if not eof(makewalkerp) then begin
      writeln(output,'Commands are being read from the end of makewalkerp');
      while not eof(makewalkerp) do copyaline(makewalkerp, w);
   end;
   writeln(w);
   writeln(w,'toggleprinting');
   writeln(w,'% showpage % unearth this for printing');
end;
(* end module createender *)

(* begin module makelogo.protectcharacter *)
procedure protectcharacter(c: char;
                       var protectioncharacter: char;
                       var needed: boolean);
(* In PostScript, special characters must be protected against.
This routine looks at a character c and returns a protection character
if it is needed.
The parenthesis is used in PostScript to indicate the bounds of a
string, while the percent is the comment character.  The backslash also needs
protection, since it is the escape to indicate that the next character is part
of the string. *)
begin
   if c in ['(',')','%','\']
   then begin
      protectioncharacter := '\';
      needed := true
   end
   else begin
      protectioncharacter := ' ';
      needed := false
   end
end;
(* end module makelogo.protectcharacter version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module makelogo.protectpostscript *)
procedure protectpostscript(var afile: text; c: char);
(* Special characters must be protected against!  Put out a protective
backslash for character c which would otherwise destroy the PostScript
interpreter.  The parenthesis is used in PostScript to indicate the bounds of a
string, while the percent is the comment character.  The backslash also needs
protection, since it is the escape to indicate that the next character is part
of the string. *)
var
   needed: boolean; (* is protection needed? *)
   protectionchar: char; (* is protection needed? *)
begin
   protectcharacter(c, protectionchar, needed);
   if needed then write(afile,protectionchar);
end;
(* end module makelogo.protectpostscript version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module makecolors *)
procedure makecolors(var colors, l: text);
(* make color definitions.  The code is taken from makelogo *)
var
  symbol: char; (* a symbol to which to assign a color *)
  red, green, blue: real; (* color definitions *)
begin
   reset(colors);
   while not eof(colors) do begin
      if colors^ <> '*' then begin (* skip comment lines *)
         (* implement the backslash protection scheme: *)
         if colors^ = '\' then get(colors);
         readln(colors,symbol,red,green,blue);
         write(l,'    char (');
         protectpostscript(l,symbol);
         write(l,symbol,') eq {');
         if (red = 1.0) or (red = 0.0) then write(l,round(red):1)
                                       else write(l,red:pwid:pdecolor);
         write(l,' ');
         if (green = 1.0) or (green = 0.0) then write(l,round(green):1)
                                           else write(l,green:pwid:pdecolor);
         write(l,' ');
         if (blue = 1.0) or (blue = 0.0) then write(l,round(blue):1)
                                         else write(l,blue:pwid:pdecolor);
         writeln(l,' setrgbcolor} if');
      end
      else readln(colors);
   end;
end;
(* end module makecolors *)

(* begin module makesequencearray *)
procedure makesequencearray(var book, fout: text);
(* Use the nextbase routines to create postscript code
that will generate a postscript array containing the
bases and their coordinates.
This procedure was created by starting from the demonextbase
routine in the delmod.p module library. *)
const
   basesperline = 5; (* number of bases to pack on a line *)
var
   (* these variables are all defined in nextbase *)
   pie: pieceptr;
   dnalink: dnaptr;
   dnalinkspot: dnarange;
   dnaspot, length: integer;
   lastbase, endofbook: boolean;

   (* this variable is needed to catch the value of nextbase,
      so that we can check that we have not reached the end of the book. *)
   character: char;
   basecount: integer; (* number of bases counted so far *)
   theline: integer; (* line in the book *)
begin
   initnextbase(book, pie, lastbase, endofbook, theline);

   writeln(fout);
   writeln(walk,'% Define the sequence and associated variables');
   writeln(fout,'/storeseq{ % coord base storeseq -');
   writeln(fout,'% store the base #',
                ' at the internal coordinate in the sequence');
   writeln(fout,'/base exch def');
   writeln(fout,'/coord exch def');
   writeln(fout,'sequence place [base coord] put');
   writeln(fout,'/place place 1 add def');
   writeln(fout,'} bind def');

   writeln(fout,'/a {0 storeseq} def');
   writeln(fout,'/c {1 storeseq} def');
   writeln(fout,'/g {2 storeseq} def');
   writeln(fout,'/t {3 storeseq} def');
(*   writeln(fout,'/symbols [(A) (C) (G) (T)] def');*)
   writeln(fout,'/symbols [(a) (c) (g) (t)] def');

   writeln(fout,'/place 0 def');

   writeln(fout,'% The sequence is expressed as:');
   writeln(fout,'% the published coordinate of the base');
(* writeln(fout,'% the internal coordinate of the base'); *)
   writeln(fout,'% the base at that coordinate');
   basecount := 0;
{
the following code allows multiple sequences to be read, but
there is no way to handle this quite yet
qqq
   while not endofbook do begin
}
   repeat
      character:=basetochar(
         nextbase(book, theline, pie,dnalink,dnalinkspot,
                  dnaspot,length,lastbase,endofbook));
      if not endofbook then begin

          if dnaspot = 1 then begin
             writeln(fout,'/sequencelength ',piecelength(pie):1,' def');
             writeln(fout,'% sequencelength is the number',
                          ' of bases in the sequence');
             writeln(fout,'/sequence sequencelength array def');
             writeln(fout,'% upperseq is the highest internal coordinate');
             writeln(fout,'/upperseq sequencelength 1 sub def');
          end;

          (* note: internal coordinates start with zero in postscript
             since postscript arrays start at zero.  So we report
             that the base is at position dnaspot-1 *)
          (* Now the program has been modified so that the spot
             is not reported.  This reduces the size of the walker file.*)

          if (basecount mod basesperline) <> 0 then write(fout,' ');
          basecount := succ(basecount);
          write(fout,    inttopie(dnaspot,pie):1,
                  (* ' ',(dnaspot-1):1, *)
                     ' ',character);
          if (basecount mod basesperline) = 0 then writeln(fout);
      end;
      if lastbase then begin
         writeln(fout);
         writeln(fout,'% end of a piece ',length:1,' bp')
      end;
   until lastbase;
{
   end
}
end;
(* end module makesequencearray *)

(* begin module makeribl *)
procedure makeribl(var ribl, walk: text; var fromwanted, towanted: integer;
                   var riblmatrix: ribltypeptr);
(* Make the Ri(b,l) matrix in PostScript in the walk file.  The matrix ranges
from frombase to tobase.  The part to write out is fromwanted to towanted.
Define the mean and standard deviation of the Ri distribution as variables.
*)
var
   position: integer; (* position in the riblmatrix *)
begin
   reset(ribl);
   getriblmatrix(ribl, riblmatrix);

with riblmatrix^ do begin
   writeln(walk);
   writeln(walk,'% Define the Ribl matrix and associated variables');
   writeln(walk,'/frombase ',frombase:1,' def');
   writeln(walk,'/tobase ',tobase:1,' def');
   writeln(walk,'/fromwanted ',fromwanted:1,' def');
   writeln(walk,'/towanted ',towanted:1,' def');
   writeln(walk,'/mean ',mean:infofield:infodecim,' def');
   writeln(walk,'/stdev ',stdev:infofield:infodecim,' def');
   writeln(walk,'/negativeinfinity ',-ln(n)/ln(2):infofield:infodecim,' def');
   writeln(walk);
   writeln(walk,'/maxribl towanted fromwanted sub 1 add def');
   writeln(walk,'/ribl maxribl array def');
   writeln(walk,'/ribllength tobase frombase sub def');
   writeln(walk);
   writeln(walk,'/storeribl{ % avalue cvalue gvalue tvalue storeribl -');
   writeln(walk,'% store the four values at place in the ribl');
   writeln(walk,'/tvalue exch def');
   writeln(walk,'/gvalue exch def');
   writeln(walk,'/cvalue exch def');
   writeln(walk,'/avalue exch def');
   writeln(walk,'ribl place [avalue cvalue gvalue tvalue] put');
   writeln(walk,'/place place 1 add def');
   writeln(walk,'} bind def');

   writeln(walk,'/place 0 def');

   for position := frombase to tobase do begin
       write(walk,' ',data[a,position]:infofield:infodecim);
       write(walk,' ',data[c,position]:infofield:infodecim);
       write(walk,' ',data[g,position]:infofield:infodecim);
       write(walk,' ',data[t,position]:infofield:infodecim);
       writeln(walk,' storeribl % ',position:1);
   end;
   writeln(walk,'/riblzero frombase neg def');

   writeln(walk);
   writeln(walk,'/showribl{ % show the current ribl matrix');
   writeln(walk,'0 1 ribllength { % loop through the matrix; put on stack');
   writeln(walk,'  /place exch def');
   writeln(walk,'  ribl place get');
   writeln(walk,'} for');
   writeln(walk,'(the current riblmatrix is:) =');
   writeln(walk,'pstack');
   writeln(walk,'0 1 ribllength { % remove from stack');
   writeln(walk,'pop pop } for');
   writeln(walk,'(should be cleared stack:) =');
   writeln(walk,'pstack');
   writeln(walk,'(end of cleared stack) =');
   writeln(walk,'frombase = (frombase) =');
   writeln(walk,'tobase = (tobase) =');
   writeln(walk,'fromwanted = (fromwanted) =');
   writeln(walk,'towanted = (towanted) =');
   writeln(walk,'} bind def');

   writeln(walk);
   writeln(walk,'/invertribl{ % invert the ribl matrix');
   writeln(walk,'0 1 ribllength { % loop through the matrix; put on stack');
   writeln(walk,'  /place exch def');
   writeln(walk,'  ribl place get');
   (* now we must reverse the 4 bases! *)
   writeln(walk,'  /acgt exch def');
   writeln(walk,'  acgt 3 get');
   writeln(walk,'  acgt 2 get');
   writeln(walk,'  acgt 1 get');
   writeln(walk,'  acgt 0 get');
   writeln(walk,'  4 array astore');
   writeln(walk,'} for');

   writeln(walk,'0 1 ribllength { % loop through stack put into matrix');
   writeln(walk,'  /place exch def');
   writeln(walk,'  /hold exch def');
   writeln(walk,'  ribl place hold put');
   writeln(walk,'} for');

   writeln(walk,'/hold frombase def');
   writeln(walk,'/frombase tobase neg def');
   writeln(walk,'/tobase hold neg def');

   writeln(walk,'/hold fromwanted def');
   writeln(walk,'/fromwanted towanted neg def');
   writeln(walk,'/towanted hold neg def');

   writeln(walk,'/hold rangefrom def');
   writeln(walk,'/rangefrom rangeto neg def');
   writeln(walk,'/rangeto hold neg def');

   writeln(walk,'/riblzero frombase neg def');
   writeln(walk,'/wavephase wavephase neg def');
   writeln(walk,'(ribl matrix inverted) =');

   writeln(walk,'} bind def');

end
end;
(* end module makeribl *)

(* begin module makelogo.truth *)
procedure truth(var f: text; b: boolean);
(* write the true-false value of b to file f *)
begin
  if b then write(f,'true')
       else write(f,'false');
end;
(* end module makelogo.truth *)

(* begin module varchardefs *)
procedure varchardefs(var l, colors: text;
                      showingbox, outline, shrinking: boolean);
(* write the PostScript procedures for making variable character
sizes to the file l.  Show the box around the character or make the character
in outline if these booleans are true.  These routines come from makelogo. *)
begin

writeln(l);
writeln(l,'% Make the variable character size definition functions');
write  (l,'/showingbox '); truth(l,showingbox); writeln(l,' def');
write  (l,'/outline '); truth(l,outline); writeln(l,' def');
write  (l,'/shrinking '); truth(l,shrinking); writeln(l,' def');

writeln(l);
if outline then begin
  writeln(l,'% Since outlining goes around the inner edge of the character');
  writeln(l,'% make the thickness of the character bigger to compensate.');
  writeln(l,'/setthelinewidth {2 setlinewidth} def')
end
else begin
  writeln(l,'/setthelinewidth {1 setlinewidth} def')
end;
writeln(l,'setthelinewidth % set to normal linewidth');

(* note:  this is redundant ... *)
writeln(l);
writeln(l,'% Set up the font size for the graphics');
writeln(l,'/fontsize charwidth def');
writeln(l);

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

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

writeln(l,'/boxshow { % xsize ysize char boxshow');
writeln(l,'% show the character with a box around it, sizes in points');
writeln(l,'gsave');
writeln(l,'  /tc exch def % define the character');
writeln(l,'  /ysize exch def % the y size of the character');
writeln(l,'  /xsize exch def % the x size of the character');
writeln(l,'  /xmulfactor 1 def /ymulfactor 1 def');
writeln(l);

writeln(l,'  % if ysize is negative, make everything upside down!');
writeln(l,'  ysize 0 lt {');
writeln(l,'    % put ysize normal in this orientation');
writeln(l,'    /ysize ysize abs def');
writeln(l,'    xsize ysize translate');
writeln(l,'    180 rotate');
writeln(l,'  } if');
writeln(l);

writeln(l,'  showingbox {xsize ysize dashbox} if');
(* hold these out of walker since they slow down things:
writeln(l,'  % Don''t show the box if it is a vertical bar, otherwise do.');
writeln(l,'  showingbox {tc (|) ne {xsize ysize dashbox} if} if');
writeln(l);
writeln(l,'  shrinking {tc (|) ne {');
writeln(l,'    xsize knirhs mul ysize knirhs mul translate');
writeln(l,'    shrink shrink scale');
writeln(l,'  } if} if');
writeln(l);
*)

writeln(l,'  2 {');
writeln(l,'    gsave');
writeln(l,'    xmulfactor ymulfactor scale');
writeln(l,'    tc charparams');
writeln(l,'    grestore');
writeln(l);

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

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

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

writeln(l,'  /xmove xmulfactor lx mul neg def');
writeln(l,'  /ymove ymulfactor ly mul neg def');
writeln(l);

writeln(l,'  newpath');
writeln(l,'  xmove ymove moveto');
writeln(l,'  xmulfactor ymulfactor scale');
writeln(l);

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

writeln(l,'grestore');
writeln(l,'} bind def');
writeln(l);

writeln(l,'/numchar{ % charheight character numchar');
writeln(l,'% Make a character of given height in cm,');
{writeln(l,'% then move vertically by that amount'); NOT NEEDED FOR WALKER}
writeln(l,'  gsave');
writeln(l,'    /char exch def');
writeln(l,'    /charheight exch cm def');

(* set up the color statements *)
makecolors(colors, l);

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

writeln(l,'    charwidth charheight char boxshow');
writeln(l,'  grestore');

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

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

if gooddisplay
then writeln(l,'  0 charheight abs translate')
else writeln(l,'  charheight abs 1 gt {0 charheight abs translate} if');

writeln(l,'} bind def'); (* numchar *)
writeln(l);
end;

(* end module varchardefs *)

(* begin module definecosine *)
procedure definecosine(var w: text);
(* define the cosine routine.
example test:
% amplitude  phase  wavelength  base:
 -2.50000 cm  6.40000 cm  8.48000 cm  7.50000 cm
% xmin ymin xmax ymax step:
 -4.80000 cm  0.00000 cm 17.60000 cm 50.50000 cm 1
  0.5 cm 0.1 cosine
*)
begin
writeln(w);
writeln(w,'/degpercycle 360 def');
writeln(w,' ');
writeln(w,'/cosine {%    amplitude  phase  wavelength  base');
writeln(w,'%             xmin ymin xmax ymax step dash thickness');
writeln(w,'%             cosine -');
writeln(w,'% draws a cosine wave with the given parameters:');
writeln(w,'% amplitude (points): height of the wave');
writeln(w,'% phase (points): starting point of the wave');
writeln(w,'% wavelength (points): length from crest to crest');
writeln(w,'% base (points): lowest point of the curve');
writeln(w,'% xmin ymin xmax ymax (points): region in which to draw');
writeln(w,'% step steps for drawing a cosine wave');
writeln(w,'% dash if greater than zero, size of dashes of the wave (points)');
writeln(w,'% thickness if greater than zero, thickness of wave (points)');
writeln(w);
writeln(w,'  /thickness exch def');
writeln(w,'  /dash exch def');
writeln(w,'  /step exch def');
writeln(w,'  /ymax exch def');
writeln(w,'  /xmax exch def');
writeln(w,'  /ymin exch def');
writeln(w,'  /xmin exch def');
writeln(w,'  /base exch def');
writeln(w,'  /wavelength exch def');
writeln(w,'  /phase exch def');
writeln(w,'  /amplitude exch def');
writeln(w,'  % fun := amplitude*cos( ((-y-phase)/wavelength)*360) + base');
writeln(w,'  /fun {phase sub wavelength div degpercycle mul cos');
writeln(w,'           amplitude mul base add} def');
writeln(w);
writeln(w,'  gsave');
writeln(w,'    /originallinewidth currentlinewidth def');
writeln(w,'    thickness 0 gt {thickness setlinewidth} if');
writeln(w,'    /c currentlinewidth def');
writeln(w,'%   Make the curve fit into the region specified');
writeln(w,'    newpath');
writeln(w,'    xmin ymin c sub moveto');
writeln(w,'    xmax ymin c sub lineto');
writeln(w,'    xmax ymax c add lineto');
writeln(w,'    xmin ymax c add lineto');
writeln(w,'    closepath');
writeln(w,'    clip'); (* stroke'); *)
writeln(w);
writeln(w,'    newpath');
writeln(w,'    xmin dup fun moveto');
writeln(w,'    xmin step xmax { % loop from xmin by step to xmax');
writeln(w,'      dup fun lineto } for');
writeln(w,'    dash 0 gt {[dash cvi] 0 setdash} if % turn dash on');
writeln(w,'    stroke');
writeln(w);
writeln(w,'    originallinewidth setlinewidth');
writeln(w,'  grestore');
writeln(w,'} bind def');
writeln(w);
end;
(* end module definecosine *)

(* begin module definewait *)
procedure definewait(var w: text);
(* define the wait procedures and variables *)
begin
writeln(w);
writeln(w,'/isasecond { % set the number of {1 pop} cycles per second');
writeln(w,'/second exch def');
writeln(w,'(a second is now defined as this many loops:) rpt');
writeln(w,'second rpt');
writeln(w,'} def');

writeln(w,'/wait {% n wait -; wait n seconds');
(* writeln(w,'(wait start) rpt'); *)
writeln(w,'second mul round cvi {1 pop} repeat');
(* writeln(w,'(wait stop) rpt'); *)
writeln(w,'} def');

writeln(w,'/setwait {% set the wait time after display');
writeln(w,'/waittime exch def');
writeln(w,'(waiting between moves is now (seconds):) rpt');
writeln(w,'waittime rpt');
writeln(w,'} def');

(* writeln(w,isasecond:1,' isasecond');
   This is unnecessary - see the help command *)
(* writeln(w,'0 setwait');  This is unnecessary - see the help command *)
writeln(w,'/second ',isasecond:1,' def');
writeln(w,'/waittime 0 def');
end;
(* end module definewait *)

(* begin module def1 *)
procedure def1(var w: text);
(* part 1 of the definitions *)
begin (* [ *)

writeln(w);
writeln(w,'/definepageparameters { % wrap these definitions together');
writeln(w,'% define characters');
writeln(w,'/charwidth pagewidth basesperline div def % character width');
writeln(w,'/ncharwidth charwidth neg def % negative of charwidth');
writeln(w,'/charshift charwidth 6 div def');
writeln(w,'/upperbound 2 def % upper bound, bits');
writeln(w,'outofsequence');
writeln(w,'{/gapbits upperbound fractionofline mul def} % gap size in bits');
writeln(w,'{/gapbits 0 def}');
writeln(w,'ifelse');
writeln(w,'/bitspercm');
writeln(w,'   upperbound lowerbound sub gapbits add % bits');
writeln(w,'   pageheight linesperpage div % cm');
writeln(w,'   div def % bits per cm');
writeln(w,'/cmperbit 1 bitspercm div def');
writeln(w,'/gapcm gapbits bitspercm div def % the gap size in cm');
writeln(w,'/charupper upperbound bitspercm div def',
          ' % upper bound of characters');
writeln(w,'/charlower lowerbound bitspercm div def',
          ' % lower bound of characters');
writeln(w,'/charrange charupper charlower sub def',
          ' % total height of character box');

writeln(w,'/charbox { % character box');
writeln(w,'moveto');
writeln(w,'charwidth 0 rlineto');
writeln(w,'ncharwidth 0 rlineto');
writeln(w,'0 charlower rlineto');
writeln(w,'charwidth 0 rlineto');
writeln(w,'0 charrange rlineto');
writeln(w,'ncharwidth 0 rlineto');
writeln(w,'closepath} bind def');

writeln(w,'% convert bits to cm fitting the size');
writeln(w,'/bittocm charupper 2 div cmfactor div def');
writeln(w,'/bittocm2 charupper cmfactor div def');

writeln(w,'% oh boy here we go with the sine!!!   YOWWW!!!');
writeln(w,'/wavelength 10.6 def % bases per 360 degrees');
writeln(w,'/wavefactor 360 wavelength div def');

writeln(w,'/makesine {% scale the y axis by the cosine of');
writeln(w,'% the distance from the internalcoordinate');
writeln(w,'ic internalcoordinate sub wavephase sub wavefactor mul');
writeln(w,'cos 1 sub -4 div 0.5 add');
writeln(w,'gapbits 0 eq {bittocm2} {gapbits} ifelse mul');
writeln(w,'} bind def');

writeln(w);
writeln(w,'% define fonts and characters');
writeln(w,'% Set up the font size for the graphics');
writeln(w,'/fontsize charwidth def');
writeln(w,'% set the font');
(*writeln(w,'/Helvetica-Bold findfont fontsize scalefont setfont');*)
writeln(w,'/Times-Bold findfont fontsize scalefont setfont');

writeln(w);
writeln(w,'} bind def % end of definepageparameters');
writeln(w,'definepageparameters % make these definitions available now!');

writeln(w);
writeln(w,'% define colors ');
writeln(w,'/red    {1 0 0 setrgbcolor} def');
writeln(w,'/green  {0 1 0 setrgbcolor} def');
writeln(w,'/blue   {0 0 1 setrgbcolor} def');
writeln(w,'/purple {1 0 1 setrgbcolor} def');
writeln(w,'/yellow {1 1 0 setrgbcolor} def');
writeln(w,'/orange {1 0.7 0 setrgbcolor} def');
writeln(w,'/black  {0 0 0 setrgbcolor} def');
writeln(w,'/white  {1 1 1 setrgbcolor} def');
writeln(w,'/grey   {0.5 0.5 0.5 setrgbcolor} def');

writeln(w);
writeln(w,'% store the current color as a background color');
writeln(w,'/setbackcolor',
          ' {/backcolorstore currentrgbcolor 3 array astore def} def');
writeln(w,'% backcolor retrieves the color');
writeln(w,'/backcolor {backcolorstore aload pop setrgbcolor} def');
writeln(w,'% initial setting');
writeln(w,'white setbackcolor');

writeln(w);
writeln(w,'/rectangle { % height width x y rectangle (path)');
writeln(w,'moveto');
writeln(w,'/height exch def');
writeln(w,'/width exch def');
writeln(w,'0 width rlineto');
writeln(w,'height 0 rlineto');
writeln(w,'0 width neg rlineto');
writeln(w,'closepath');
writeln(w,'} bind def');

definewait(w);
(* A smooth cosine is not used in this version of walker.  It
is hard to implement and would be slow.
definecosine(w);
*)

writeln(w);
writeln(w,'/tochar {x charwidth mul y charrange');
writeln(w,'outofsequence {gapcm add charshift add} if');
writeln(w,'mul} def ');

writeln(w);
writeln(w,'/stepto { % x y stepto -  stepto the place');
writeln(w,'/y exch def');
writeln(w,'/x exch def');
writeln(w,'tochar charbox fill');
writeln(w,'gsave tochar charbox black stroke grestore} def');

writeln(w);
writeln(w,'/tointernal { % ec tointernal ic boolean');
writeln(w,'% convert external coordinate (ec)');
writeln(w,'% to internal coordinate (ic)');
writeln(w,'% if found, the boolean is true and ic is returned.');
writeln(w,'% otherwise the boolean is false and no coordinate is returned.');
writeln(w,'/ec exch def');
writeln(w,'/ic 0 def');
writeln(w,'count /stacksize exch def');
writeln(w,'sequence {');
writeln(w,'   1 get');
writeln(w,'   ec eq');
writeln(w,'   {ic exit}');
writeln(w,'   if');
writeln(w,'   /ic ic 1 add def');
writeln(w,'} forall');
writeln(w,'count stacksize 1 add eq % element was found and returned?');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/setinternal { % externalcoordinate setinternal internalcoordinate');
writeln(w,'% convert external coordinate (externalcoordinate)');
writeln(w,'% to internal coordinate (internalcoordinate) 0 to upperseq');
writeln(w,'% if found, the internalcoordinate is set.');
writeln(w,'% If not found, internalcoordinate is set to:');
writeln(w,'%    0 if externalcoordinate <= 0');
writeln(w,'%    upperseq if externalcoordinate > 0');
writeln(w,'/externalcoordinate exch def');
writeln(w,'/internalcoordinate 0 def');
writeln(w,'externalcoordinate tointernal');
writeln(w,'not { externalcoordinate 0 le');
writeln(w,'  {0} {upperseq} ifelse');
writeln(w,'} if');
writeln(w,'dup /internalcoordinate exch def');
writeln(w,'} bind def');

writeln(w);
writeln(w,'coornumber setinternal pop % set initial internalcoordinate');

end; (* ] *)
(* end module def1 *)

(* begin module def2 *)
procedure def2(var w: text);
(* part 2 of the definitions *)
begin (* [ *)

writeln(w);
writeln(w,'/grabbasenumber { % internalcoordinate grabbase n found');
writeln(w,'% if found, found is true and the element n is next');
writeln(w,'% otherwise found is false and there is no element n.');
writeln(w,'% n is the number equivalent of the base');
writeln(w,'/ic exch def');
writeln(w,' ic 0 ge');
writeln(w,' ic upperseq le');
writeln(w,' and');
writeln(w,'   {sequence ic get');
writeln(w,'     0 get true} % extract the numerical equivalent of a letter');
writeln(w,'   {false}');
writeln(w,'ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/grabbase { % internalcoordinate grabbase c found');
writeln(w,'% if found, found is true and the element c is next');
writeln(w,'% otherwise found is false and there is no element c.');
writeln(w,'% c is the base as a character');
writeln(w,'/ic exch def');
writeln(w,' ic 0 ge');
writeln(w,' ic upperseq le');
writeln(w,' and');
writeln(w,'   {sequence ic get');
writeln(w,'    0 get % extract the numerical equivalent of a letter');
writeln(w,'    symbols exch get true} % convert to a letter ');
writeln(w,'   {false}');
writeln(w,'ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/setxy { % ic setxy boolean');
writeln(w,'% setxy takes an internal coordinate ic,');
writeln(w,'% and sees if a move to that position on the page is possible.');
writeln(w,'% if so, it sets x and y,');
writeln(w,'% and the boolean is true, otherwise false.');
writeln(w,'/ic exch def');
writeln(w,'ic 0 ge ic upperseq le and');
writeln(w,'{ % inside the sequence');
writeln(w,'   % PostScript mod is not a true modulo function!');
writeln(w,'   % So we make our own:');
writeln(w,'   /xtemp ic internalcoordinate sub basenumber add def');
writeln(w,'   /ytemp linenumber def');
writeln(w,'   { xtemp basesperline lt');
writeln(w,'     {exit}');
writeln(w,'     {/xtemp xtemp basesperline sub def');
writeln(w,'      /ytemp ytemp 1 sub def}');
writeln(w,'     ifelse');
writeln(w,'   } loop');
writeln(w,'   { xtemp 0 ge');
writeln(w,'     {exit}');
writeln(w,'     {/xtemp xtemp basesperline add def');
writeln(w,'      /ytemp ytemp 1 add def}');
writeln(w,'     ifelse');
writeln(w,'   } loop');
writeln(w,'   ytemp 0 ge');
writeln(w,'   ytemp linesperpage lt');
writeln(w,'   and');
writeln(w,'   dup {');
writeln(w,'        /x xtemp def');
writeln(w,'        /y ytemp def');
writeln(w,'   } if');
writeln(w,'}');
writeln(w,'{ % not inside the sequence');
writeln(w,'   false');
writeln(w,'}');
writeln(w,'ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/gettoxy { % ic gettoxy boolean');
writeln(w,'% gettoxy takes an internal coordinate ic,');
writeln(w,'% attempts to move the zero base of the walker');
writeln(w,'% to that position on the page');
writeln(w,'% and if it succeeds it sets x, y, basenumber and linenumber.');
writeln(w,'% Then it moves there and');
writeln(w,'% the variable internalcoordinate is set to ic.');
writeln(w,'% If it succeeds the boolean is true, otherwise false.');
writeln(w,'% If true, the zerobase will be at (basenumber, linenumber).');
writeln(w,'setxy dup');
writeln(w,'{  tochar moveto');
writeln(w,'   /basenumber x def');
writeln(w,'   /linenumber y def');
writeln(w,'} if');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/displaywalker { % show the walker');
writeln(w,'% at internalcoordinate, basenumber, linenumber');
writeln(w,'gsave');
writeln(w,'% print the zero base');
writeln(w,'/x basenumber def ');
writeln(w,'/y linenumber def');
writeln(w,'tochar moveto');
writeln(w,'currentpoint translate');
writeln(w,'% this should be the same as: ');
writeln(w,'% 0 getoxy pop');
writeln(w,'% zap previous symbol there');
writeln(w,'white 0 0 charbox fill gsave 0 0 charbox black stroke grestore');
writeln(w,'/thebase internalcoordinate grabbase not {exit} if def');
writeln(w,'/cmhigh charupper cmfactor div def ');
writeln(w,'cmhigh thebase numchar');
writeln(w,'grestore');
writeln(w,'% here do the rest of the walker');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/anycolornumchar{ % charheight character numchar');
writeln(w,'% Make a character of given height in cm,');
writeln(w,'  gsave');
writeln(w,'    /char exch def');
writeln(w,'    /charheight exch cm def');
writeln(w,'    charwidth charheight char boxshow');
writeln(w,'  grestore');
writeln(w,'  charheight abs 1 gt {0 charheight abs translate} if');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/anycolorletter { % ic colorletter');
writeln(w,'% evaluate and print the base at ic in anycolor');
writeln(w,'/ic exch def');
writeln(w,'gsave');
writeln(w,'ic setxy pop');
writeln(w,'tochar moveto');
writeln(w,'currentpoint translate');
writeln(w,'currentrgbcolor % save current color on the stack');
writeln(w,'% zap previous symbol there');
writeln(w,'backcolor 0 0 charbox fill gsave');
writeln(w,'boxstate {0 0 charbox black stroke} if grestore');
writeln(w,'setrgbcolor % restore current color from the stack');
writeln(w,'/thebase ic grabbase not {exit} if def');

writeln(w,'outofsequence');
writeln(w,'{');
writeln(w,'gsave');
writeln(w,'   0 2 bitspercm div translate');
writeln(w,'   0 0 moveto');
writeln(w,'   charwidth 0 rlineto');
writeln(w,'   0 gapcm rlineto');
writeln(w,'   ncharwidth 0 rlineto');
writeln(w,'   closepath');
writeln(w,'   white fill');
writeln(w,'   grey');
writeln(w,'   0 charshift translate');

writeln(w,'   doingwave');
writeln(w,'   {makesine thebase anycolornumchar}');
writeln(w,'   {bittocm thebase anycolornumchar}');
writeln(w,'   ifelse');
writeln(w,'grestore');
writeln(w,'}');
writeln(w,'{');
writeln(w,'gsave');
writeln(w,'   doingwave');
writeln(w,'   {makesine thebase anycolornumchar}');
writeln(w,'   {bittocm thebase anycolornumchar}');
writeln(w,'   ifelse');
writeln(w,'grestore');
writeln(w,'}');
writeln(w,'ifelse');

writeln(w,'grestore');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/evaluate { % ic evaluate bits');
writeln(w,'% give the bits at position ic');
writeln(w,'/ic exch def');
writeln(w,'ribl');
writeln(w,'ic internalcoordinate sub riblzero add get');
writeln(w,'ic grabbasenumber pop get} bind def');

end; (* ] *)
(* end module def2 *)

(* begin module def3 *)
procedure def3(var w: text);
(* part 3 of the definitions *)
const
  linestrlength = 60; (* length of an output line *)
var
  blanks: integer; (* for writing blanks *)
  atspot: integer; (* location of at on output display *)
  rispot: integer; (* location of Ri on output display *)
  zspot:  integer; (* location of Z on output display *)
begin (* [ *)

writeln(w);
writeln(w,'/colorletter { % ic colorletter');
writeln(w,'% evaluate and print the base at ic in color');
writeln(w,'/ic exch def');
writeln(w,'gsave');
writeln(w,'ic setxy pop');
writeln(w,'tochar moveto');
writeln(w,'currentpoint translate');
writeln(w,'% zap previous symbol there');
writeln(w,'backcolor 0 0 charbox fill gsave');
writeln(w,'boxstate {0 0 charbox black stroke} if grestore');
writeln(w,'/thebase ic grabbase not {(colorletter error) rpt exit} if def');

writeln(w,'gsave');
writeln(w,'outofsequence');
writeln(w,'{');
writeln(w,'   0 2 bitspercm div translate');
writeln(w,'   0 0 moveto');
writeln(w,'   charwidth 0 rlineto');
writeln(w,'   0 gapcm rlineto');
writeln(w,'   ncharwidth 0 rlineto');
writeln(w,'   closepath');
writeln(w,'   white fill');
writeln(w,'   blue');
writeln(w,'   0 charshift translate');
writeln(w,'   doingwave');
writeln(w,'   {makesine thebase anycolornumchar}');
writeln(w,'   {1 thebase anycolornumchar}');
writeln(w,'   ifelse');
writeln(w,'}');
writeln(w,'{');
writeln(w,'   doingwave');
writeln(w,'   {  % draw line at wave');
writeln(w,'      0 makesine cm currentlinewidth sub moveto');
writeln(w,'      charwidth 0 rlineto');
writeln(w,'      grey stroke');
writeln(w,'   } if');
writeln(w,'}');
writeln(w,'ifelse');
writeln(w,'grestore');

writeln(w,'/bits ic evaluate def');
writeln(w,'/cmhigh bits bittocm mul def');
writeln(w,'bits 0 lt {');
writeln(w,'   bits lowerbound lt');
writeln(w,'   {');
writeln(w,'      newpath');
writeln(w,'      0 0 moveto');
writeln(w,'      0 charlower rlineto');
writeln(w,'      charwidth 0 rlineto');
writeln(w,'      0 charlower neg rlineto');
writeln(w,'      closepath');
writeln(w,'      clip');
writeln(w,'      bits negativeinfinity lt');
writeln(w,'      {black}');
writeln(w,'      {purple}');
writeln(w,'      ifelse');
writeln(w,'      fill');
writeln(w,'      0 cmhigh cm translate');
writeln(w,'      cmhigh thebase numchar');
writeln(w,'      initclip');
(*
writeln(w,'      bits rpt');
*)
writeln(w,'   } ');
writeln(w,'   {');
writeln(w,'      0 cmhigh cm translate');
writeln(w,'      cmhigh thebase numchar');
writeln(w,'   }');
writeln(w,'   ifelse');
writeln(w,'   }');
writeln(w,'   {cmhigh thebase numchar}');
writeln(w,'ifelse');
writeln(w,'grestore');
writeln(w,'} bind def');

writeln(w);
writeln(w,'% mechanism for finding the total Ri value evaluated');
writeln(w,'/sumribl {/ribltotal ribltotal bits add def} def');

writeln(w);
writeln(w,'% string for numbers');
writeln(w,'/str 10 string def');
writeln(w,'/linestr ',linestrlength:1,' string def');
writeln(w,'/onedecimal {10 mul round 10 div} def % 1 decimal');

writeln(w,'/fourdecimal {% number location fourdecimal');
writeln(w,'% put the number at the location in linestr.');
writeln(w,'% use 4 decimal places, and put a blank for the positive sign');
writeln(w,'/numberlocation exch def');
writeln(w,'/numbervalue exch def');
writeln(w,'linestr');
writeln(w,'numberlocation');
writeln(w,'  numbervalue -100 gt');
writeln(w,'  {');
writeln(w,'  numbervalue 0 gt {1 add} if');
writeln(w,'  % numbervalue abs 9 gt { numbervalue abs log cvi sub } if');
writeln(w,'  numbervalue abs 9 gt { numbervalue abs log cvi sub } if');
writeln(w,'  numbervalue 10000 mul round 10000 div');
writeln(w,'  str cvs putinterval');
writeln(w,'  }');
writeln(w,'  {');
writeln(w,'  1 sub');
writeln(w,'  (-Infinity) putinterval');
writeln(w,'  }');
writeln(w,'ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/displaydata {');
writeln(w,'% Display the ribltotal');
writeln(w,'/Z ribltotal mean sub stdev div def');
writeln(w,'ribltotal ribound gt Z abs zbound le and');
writeln(w,'{0.4 0.2 1 sethsbcolor setbackcolor} % greenish');
writeln(w,'{1 0.2 1 sethsbcolor setbackcolor} % pink');
writeln(w,'ifelse');
writeln(w,'gsave');
writeln(w,'   internalcoordinate colorletter');
writeln(w,'   internalcoordinate setxy pop');
writeln(w,'   tochar charbox clip');
writeln(w,'   tochar translate');
writeln(w,'   0 0 moveto');
writeln(w,'      internalcoordinate evaluate 0 le');
writeln(w,'      { black charwidth 0 translate 0 0 moveto 90 }');
writeln(w,'      { black 0 0 moveto -90 }');
writeln(w,'   ifelse');
writeln(w,'   rotate 0 charshift moveto');

writeln(w,'   /externalcoordinate sequence internalcoordinate get 1 get def');

writeln(w,'   externalcoordinate str cvs show');
writeln(w,'   ( ) show');
writeln(w,'   ribltotal onedecimal');
writeln(w,'   str cvs show');
writeln(w,'   ( ) show');
writeln(w,'   Z onedecimal');
writeln(w,'   str cvs show');
writeln(w,'   initclip');
writeln(w,'grestore');

writeln(w,'white setbackcolor');

(* The following code combines all the display data into one line *)
write  (w,'linestr 0 (');
for blanks := 1 to linestrlength do write(w,' ');
writeln(w,') putinterval');
atspot := 0;
writeln(w,'linestr ',atspot:1,' (at ) putinterval');
writeln(w,'linestr ',atspot+3:1,' externalcoordinate str cvs putinterval');
rispot := 11;
writeln(w,'linestr ',rispot:1,' ( Ri =) putinterval');
writeln(w,'ribltotal ',rispot+6:1,' fourdecimal');
writeln(w,'linestr ',rispot+15:1,' (bits) putinterval');
zspot := 33;
writeln(w,'linestr ',zspot:1,' ( Z =) putinterval');
writeln(w,'Z ',zspot+4:1,' fourdecimal');
writeln(w,'ribltotal ribound gt',
          ' {linestr ',zspot+12:1,' (++++) putinterval} if');
writeln(w,'Z abs zbound le {linestr ',zspot+17:1,' (<---) putinterval} if');
writeln(w,'linestr rpt flush'); (* force it out for immediate viewing *)

writeln(w,'} bind def');

writeln(w);
writeln(w,'/movesequence { % - movesequence -');
writeln(w,'% keep the walker steady, move the sequence to internalcoordinate');

writeln(w,'/oldlocation internalcoordinate def');
writeln(w,'/internalcoordinate newlocation def');

writeln(w,'printing { % print suppression');

writeln(w,'grey setbackcolor');
writeln(w,'internalcoordinate colorletter');
writeln(w,'white setbackcolor');

(* initialize the value at the zero coordinate! *)
writeln(w,'/ribltotal internalcoordinate evaluate def');

(* loop to display the walker *)
writeln(w,'/fromout false def');
writeln(w,'/toout false def');
writeln(w,'/dfzb 1 def % distance from zero base');

writeln(w,'{ % loop to display the walker');
writeln(w,' fromout not');
writeln(w,' { /below internalcoordinate dfzb sub def');
writeln(w,'   below setxy');
writeln(w,'   dfzb rangefrom neg le');
writeln(w,'   and');
writeln(w,'   {  tochar moveto');
writeln(w,'      below colorletter sumribl');
writeln(w,'   }');
writeln(w,'   {/fromout true def');
writeln(w,'   }');
writeln(w,'   ifelse');
writeln(w,' } if');
writeln(w,' toout not');
writeln(w,' { /above internalcoordinate dfzb add def');
writeln(w,'   above setxy');
writeln(w,'   dfzb rangeto le');
writeln(w,'   and');
writeln(w,'   {  tochar moveto');
writeln(w,'      above colorletter sumribl');
writeln(w,'   }');
writeln(w,'   {/toout true def');
writeln(w,'   }');
writeln(w,'   ifelse');
writeln(w,' } if');
writeln(w,'  fromout toout and {exit} if');
writeln(w,'  /dfzb dfzb 1 add def');
writeln(w,'} loop % for walker');

writeln(w,'displaydata');

(* If the walker is steady and there is no wave, then we don't need to display
the rest of the sequence. This speeds up the display. *)

writeln(w,'/fromout false def');
writeln(w,'/toout false def');
writeln(w,' /below below 1 add def % reset');
writeln(w,' /above above 1 sub def % reset');
writeln(w,'doingwave sequencemoves forcedisplay or or {');
writeln(w,' { % loop to display the reset of the page');
writeln(w,'  fromout not');
writeln(w,'  { /below below 1 sub def');
writeln(w,'    below setxy');
writeln(w,'    {  tochar moveto');
writeln(w,'       grey below anycolorletter');
writeln(w,'    }');
writeln(w,'    {/fromout true def');
writeln(w,'    }');
writeln(w,'    ifelse');
writeln(w,'  } if');
writeln(w,'  toout not');
writeln(w,'  { /above above 1 add def');
writeln(w,'    above setxy');
writeln(w,'    {  tochar moveto');
writeln(w,'       grey above anycolorletter');
writeln(w,'    }');
writeln(w,'    {/toout true def');
writeln(w,'    }');
writeln(w,'    ifelse');
writeln(w,'  } if');
writeln(w,'  fromout toout and {exit} if');
writeln(w,'  /dfzb dfzb 1 add def');
writeln(w,' } loop % for page');
writeln(w,'}');

writeln(w,'{ % cleanup behind walker');
writeln(w,'  /dfzb 0 def');
writeln(w,'/oldbelow oldlocation rangefrom add def');
writeln(w,'/oldabove oldlocation rangeto add def');
writeln(w,'{ % loop for clearing walker');
writeln(w,' fromout not');
writeln(w,' { /ic oldlocation dfzb sub def');
writeln(w,'   ic setxy');
writeln(w,'   ic oldbelow ge');
writeln(w,'   and   ');
writeln(w,'   {%  tochar moveto');
writeln(w,'    ic below lt ic above gt or');
writeln(w,' {grey ic anycolorletter');
writeln(w,'} if');
writeln(w,'   }');
writeln(w,'   {/fromout true def');
writeln(w,'   }');
writeln(w,'   ifelse');
writeln(w,' } if   ');
writeln(w,' toout not');
writeln(w,' { /ic oldlocation dfzb add def');
writeln(w,'   ic setxy');
writeln(w,'   ic oldabove le');
writeln(w,'   and');
writeln(w,'   {%  tochar moveto');
writeln(w,'    ic below lt ic above gt or');
writeln(w,'    {grey ic anycolorletter');
writeln(w,'} if');
writeln(w,'   }');
writeln(w,'   {/toout true def');
writeln(w,'   }');
writeln(w,'   ifelse');
writeln(w,' } if');
writeln(w,'  fromout toout and {exit} if');
writeln(w,'  /dfzb dfzb 1 add def');
writeln(w,'} loop % for removing old walker');
writeln(w,'}');

writeln(w,'ifelse');

writeln(w,'waittime wait');
writeln(w,'} if % print suppression');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/movewalker { % - movewalker -');
writeln(w,'% keep the sequence steady, move the walker to internalcoordinate');
writeln(w,'% change the position on the page also!');
writeln(w,'newlocation setxy');
writeln(w,'{% we can move there');
writeln(w,'/basenumber x def');
writeln(w,'/linenumber y def');
writeln(w,'movesequence');
writeln(w,'} % we can move there');
writeln(w,'{ (It''s not possible to move there because ) rpt');
writeln(w,'  newlocation 0 lt newlocation upperseq gt or');
writeln(w,'  {(it''s off the sequence) rpt}');
writeln(w,'  {(it''s off the page',
          ' - perhaps switch to sequence-move mode? [use w command]) rpt}');
writeln(w,'  ifelse');
writeln(w,'}');
writeln(w,'ifelse');
writeln(w,'} def');

writeln(w);
writeln(w,'/takestep { % value takestep - ; take a step');
writeln(w,'% the value is the new internalcoordinate');
writeln(w,'/newlocation exch def');
writeln(w,'newlocation grabbase');
writeln(w,'   {pop % the new location is ok');
writeln(w,'    % depending on the toggle we might move sequence or walker');
writeln(w,'   sequencemoves');
writeln(w,'     {movesequence}');
writeln(w,'     {movewalker}');
writeln(w,'   ifelse');
writeln(w,'   }');
writeln(w,'   {/newlocation internalcoordinate def % refuse to move');
writeln(w,'    (There Is No Sequence In That Direction!) rpt}');
writeln(w,'ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'% ERROR HANDLING');

writeln(w);
(* NOTE: for safety, = is used instead of rpt for errors *)
writeln(w,'errordict /undefined',
          ' {= (Sorry, I don''t know that command) =} put');

writeln(w);
writeln(w,'% The following can only be done ONCE');
writeln(w,'pagex pagey translate % done ONCE');
writeln(w,'0 charlower neg translate % move to zero of the character box');
writeln(w);

end; (* ] *)
(* end module def3 *)

(* begin module def4 *)
procedure def4(var w: text);
(* part 4 of the definitions *)
begin (* [ *)
writeln(w,'/searchtest {% test if the search should end');
writeln(w,'ribltotal ribound gt Z abs zbound le and');
writeln(w,'{(Found one!)rpt exit} if');
writeln(w,'} bind def');
end; (* ] *)
(* end module def4 *)

(* begin module definitions *)
procedure definitions(var w: text);
(* define functions and initial values.  This has to be broken into several
parts because the compiler runs out of memory otherwise.  This happens because
these are routines heavy in the use of literals, and those take lots of memory.
*)
begin
  def1(w);
  def2(w);
  def3(w);
  def4(w);
end;
(* end module definitions *)

(* begin module displayentirepage *)
procedure displayentirepage(var w: text);
(* display the entire page *)
begin
writeln(w,'/pageerase {% erase printable window');
writeln(w,'gsave');
writeln(w,'  0 0 moveto');
writeln(w,'  llx lly lineto');
writeln(w,'  urx lly lineto');
writeln(w,'  urx ury lineto');
writeln(w,'  llx ury lineto');
writeln(w,'  llx lly lineto');
writeln(w,'  clip');
writeln(w,'  erasepage');
writeln(w,'grestore');
writeln(w,'} bind def');
writeln(w,'/displayentirepage {% display the entire page');
(*
pageheight pagewidth 0 0 rectangle white fill
0 charlower neg translate % move to zero of the character box
*)
writeln(w,'printing {');
writeln(w,'  DoErasePage {pageerase} if');
writeln(w,'  definepageparameters');
writeln(w,'  boxstate {');
writeln(w,'     0 1 linesperpage 1 sub');
writeln(w,'     { /y exch def');
writeln(w,'          0 1 basesperline 1 sub');
writeln(w,'          { /x exch def');
writeln(w,'                tochar charbox blue stroke');
writeln(w,'          } for');
writeln(w,'     } for');
writeln(w,'  } if');
writeln(w,'  /forcedisplay true def');
writeln(w,'  internalcoordinate takestep');
writeln(w,'  /forcedisplay false def');
writeln(w,'} if');
writeln(w,'} bind def');
end;
(* end module displayentirepage *)

(* begin module defineusercommands *)
procedure defineusercommands(var w: text);
(* define the user commands and their consequences *)
begin

writeln(w);
writeln(w);
writeln(w,'% USER DEFINITIONS');

writeln(w);
writeln(w,'/r { % redisplay the page');
writeln(w,' displayentirepage ');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/cl { % clear the ghostscript command screen with control-L');
writeln(w,' () ='); (* this is a control-L character *)
writeln(w,'} bind def');

writeln(w);
writeln(w,'/R { % reset everything');
writeln(w,'clear');
writeln(w,'(clearing stack, graphics state and restarting program) rpt');
writeln(w,'clear');
{
writeln(w,'initgraphics');
writeln(w,'erasepage');
}
writeln(w,'(walk) run');
writeln(w,'} bind def');

writeln(w);
writeln(w,'% Movement Commands, as in vi');

writeln(w,'/h { % move left');
writeln(w,'count 0 le {1} if');
writeln(w,'dup 0 lt');
writeln(w,'  {abs l}'); (* a subtle trick: call the other if it's negative! *)
writeln(w,'  {{internalcoordinate 1');
writeln(w,'    sequencemoves {add} {sub} ifelse takestep} repeat}');
writeln(w,'ifelse');
writeln(w,'} def');

writeln(w,'/l { % move right');
writeln(w,'count 0 le {1} if');
writeln(w,'dup 0 lt');
writeln(w,'  {abs h}'); (* a subtle trick: call the other if it's negative! *)
writeln(w,'  {{internalcoordinate 1');
writeln(w,'    sequencemoves {sub} {add} ifelse takestep} repeat}');
writeln(w,'ifelse');
writeln(w,'} def');

writeln(w,'/j { % move down');
writeln(w,'count 0 le {1} if');
writeln(w,'dup 0 lt');
writeln(w,'  {abs k}'); (* a subtle trick: call the other if it's negative! *)
writeln(w,'  {{internalcoordinate basesperline');
writeln(w,'    sequencemoves {sub} {add} ifelse takestep} repeat}');
writeln(w,'ifelse');
writeln(w,'} def');

writeln(w,'/k { % move up');
writeln(w,'count 0 le {1} if');
writeln(w,'dup 0 lt');
writeln(w,'  {abs j}'); (* a subtle trick: call the other if it's negative! *)
writeln(w,'  {{internalcoordinate basesperline');
writeln(w,'  sequencemoves {add} {sub} ifelse takestep} repeat}');
writeln(w,'ifelse');
writeln(w,'} def');

writeln(w);
writeln(w,'% Toggle to define whether the sequence moves or the walker moves');
writeln(w,'/sequencemoves false def');
writeln(w,'/w {/sequencemoves sequencemoves not def');
writeln(w,'sequencemoves {(Sequence Moves)} {(walker Moves)} ifelse rpt');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/boxes {/boxstate boxstate not def displayentirepage} def');

writeln(w);
writeln(w,'/q {grestore quit} def');

writeln(w);
writeln(w,'/? {help} def');

writeln(w);
writeln(w,'/help {(Detailed instructions for makewalker ',version:4:2,
                  ' are given in) rpt');
writeln(w,'(the source code file makewalker.p.) rpt');

writeln(w,'(# means you must supply a number',
          ' BEFORE you type the command name.)rpt');
writeln(w,'(# h: move left [# is optional])rpt');
writeln(w,'(# j: move down [# is optional])rpt');
writeln(w,'(# k: move up [# is optional])rpt');
writeln(w,'(# l: move right [# is optional])rpt');
writeln(w,'(w: toggle between walker and sequence moving)rpt');
writeln(w,'(q: quit)rpt');
writeln(w,'(?: help message)rpt');
writeln(w,'(r: Refresh the page)rpt');
writeln(w,'(cl: clear the ghostscript command screen)rpt');
writeln(w,'(R: restart ghostscript on the current walk file)rpt');
writeln(w,'(# A,C,G,T:',
          ' Mutate the given absolute location to the desired base)rpt');
writeln(w,'(# a,c,g,t:',
          ' Mutate the given relative location to the desired base)rpt');
writeln(w,'(# goto: go to the given coordinate)rpt');
writeln(w,'(# invert: invert the ribl matrix)rpt');
writeln(w,'(# jump: jump a relative number of bases)rpt');
writeln(w,'(boxes: toggle between having boxes and not)rpt');
writeln(w,'(# lines (line): Set the number of lines per page)rpt');
writeln(w,'(# bases (base, wide): Set the number of bases per page)rpt');
writeln(w,'(# left, right, up, down: move the graphic on the page',
          ' in units of cm)rpt');
(* writeln(w,'(  [no # means 1 cm])rpt'); not worth the text of coding *)
writeln(w,'(# height, width: set the page height or width in cm)rpt');
writeln(w,'(# lower: set the lower bound in bits)rpt');
writeln(w,'(in: put the walker into the sequence)rpt');
writeln(w,'(out: take the walker out of the sequence)rpt');
writeln(w,'(# wave: define base at which the low point of the',
          ' cosine wave is set)rpt');
writeln(w,'(waveon: turns on drawing the wave.)rpt');
writeln(w,'(waveoff: turns off drawing the wave)rpt');
writeln(w,'(toggleprinting or tp:',
          ' a toggle that turns on and off printing) rpt');
writeln(w,'(toggleerase or te: a toggle that turns on and off page erase) rpt');
writeln(w,'(togglereport or tr:',
          ' a toggle that turns on and off output to user) rpt');
writeln(w,'(# from: change FROM range of the matrix to use) rpt');
writeln(w,'(# to: change TO range of the matrix to use) rpt');
writeln(w,'(help: help message) rpt');
writeln(w,'(# setwait: set the wait time in seconds after display) rpt');
writeln(w,'(       waittime is currently:) rpt waittime rpt');
writeln(w,'(# isasecond: set the number of {1 pop} cycles per second) rpt');
writeln(w,'(       seconds is currently:) rpt second rpt');
writeln(w,'(# setri: set minimum Ri for searching and display) rpt');
writeln(w,'(       ribound is currently:) rpt ribound rpt');
writeln(w,'(# setz: set minimum Z for searching and display) rpt');
writeln(w,'(       zbound is currently:) rpt zbound  rpt');
writeln(w,'(# f: search forward to next site which fits search criteria) rpt');
writeln(w,'(# b: search backward to next site which fits search criteria) rpt');
writeln(w,'(NOTE: if the command line has a number (eg "GS<3>"),',
          ' type "=" until it''s gone.) rpt');

writeln(w,'} def');

writeln(w);
writeln(w,'/in { % make the walker be in the sequence');
writeln(w,'/outofsequence false def');
writeln(w,'displayentirepage');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/out { % make the walker be out of the sequence');
writeln(w,'/outofsequence true def');
writeln(w,'displayentirepage');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/goto {');
writeln(w,'count 0 le');
writeln(w,'{(To use the "goto" command to go to coordinate 180,',
          ' type "180 goto") rpt}');
writeln(w,'{cvi tointernal');
writeln(w,'  {takestep}');
writeln(w,'  {(that base is not on the sequence) rpt}');
writeln(w,'  ifelse');
writeln(w,'}');
writeln(w,'ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/invert { % invert the ribl matrix');
writeln(w,'invertribl');
writeln(w,'displayentirepage');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/jump {');
writeln(w,'count 0 le');
writeln(w,'{(To use the "jump" command to move 5 bases 5'',',
          ' type "-5 jump") rpt}');
writeln(w,'{cvi internalcoordinate add takestep}');
writeln(w,'ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/to { % set the rangeto');
writeln(w,'count 0 le');
writeln(w,'{(To use the "to" command to set rangeto to -5,',
          ' type "-5 to") rpt}');
writeln(w,'{dup tobase gt');
writeln(w,' {pop (rangeto must be smaller than tobase) rpt tobase rpt}');
writeln(w,' { dup frombase lt');
writeln(w,'   {pop (rangeto must be greater than or equal to rangefrom)',
              ' rpt rangefrom rpt}');
writeln(w,'   {/rangeto exch def');
writeln(w,'    displayentirepage}');
writeln(w,'   ifelse');
writeln(w,' } ifelse');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/from { % set the rangefrom');
writeln(w,'count 0 le');
writeln(w,'{(To use the "from" command to set rangefrom to -5,',
          ' type "-5 from") rpt}');
writeln(w,'{dup frombase lt');
writeln(w,' {pop (rangefrom must be larger than frombase) rpt frombase rpt}');
writeln(w,' { dup tobase gt');
writeln(w,'   {pop (rangefrom must be less than or equal to rangeto)',
              ' rpt rangeto rpt}');
writeln(w,'   {/rangefrom exch def');
writeln(w,'    displayentirepage}');
writeln(w,'   ifelse');
writeln(w,' } ifelse');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/bases { % set the basesperline');
writeln(w,'count 0 le');
writeln(w,'{(To use the "bases" command to set basesperline to 5,',
          ' type "5 bases") rpt}');
writeln(w,'{dup 1 lt');
writeln(w,' {pop (basesperline must be larger than 0)  rpt}');
writeln(w,' {/basesperline exch def');
writeln(w,'   /basenumber basesperline 2 idiv def');
writeln(w,'   displayentirepage}');
writeln(w,' ifelse');
writeln(w,'} ifelse');
writeln(w,'} bind def');
writeln(w,'/base {bases} def');
writeln(w,'/wide {bases} def');

writeln(w);
writeln(w,'/lines { % set the linesperpage');
writeln(w,'count 0 le');
writeln(w,'{(To use the "lines" command to set linesperpage to 5,',
          ' type "5 lines") rpt}');
writeln(w,'{dup 1 lt');
writeln(w,' {pop (linesperpage must be larger than 0)  rpt}');
writeln(w,' {/linesperpage exch def');
writeln(w,'   /linenumber linesperpage 2 idiv def');
writeln(w,'    displayentirepage}');
writeln(w,' ifelse');
writeln(w,'} ifelse');
writeln(w,'} bind def');
writeln(w,'/line {lines} def');

writeln(w);
writeln(w,'/left { % move the page left');
writeln(w,'count 0 le');
writeln(w,'{(to move left 2 cm type "2 left") rpt}');
writeln(w,'{neg cm 0 cm translate');
writeln(w,' displayentirepage');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/right { % move the page right');
writeln(w,'count 0 le');
writeln(w,'{(to move right 2 cm type "2 right") rpt}');
writeln(w,'{cm 0 cm translate');
writeln(w,' displayentirepage');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/down { % move the page down');
writeln(w,'count 0 le');
writeln(w,'{(to move down 2 cm type "2 down") rpt}');
writeln(w,'{0 exch neg cm translate');
writeln(w,' displayentirepage');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/up { % move the page up');
writeln(w,'count 0 le');
writeln(w,'{(to move up 2 cm type "2 up") rpt}');
writeln(w,'{0 exch cm translate');
writeln(w,' displayentirepage');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/height { % define the page height');
writeln(w,'count 0 le');
writeln(w,'{(page height is in cm and must be positive, eg "3 height") rpt}');
writeln(w,'{/pageheight exch cm def');
writeln(w,' displayentirepage');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/width { % define the page width');
writeln(w,'count 0 le');
writeln(w,'{(page width is in cm and must be positive, eg "3 width") rpt}');
writeln(w,'{/pagewidth exch cm def');
writeln(w,' displayentirepage');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/lower { % lower bound');
writeln(w,'count 0 le');
writeln(w,'{(to change the lower bound to -3, type "-3 lower") rpt}');
writeln(w,'{dup 0 lt');
writeln(w,' {/lowerbound exch def displayentirepage}');
writeln(w,' {(lowerbound must be negative) rpt}');
writeln(w,' ifelse');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/wave { % set the wave phase');
writeln(w,'count 0 le');
writeln(w,'{(to put the wave low point at base -3, type "-3 wave") rpt}');
writeln(w,'{/wavephase exch def');
writeln(w,' displayentirepage');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/waveon { % set the wave state on');
writeln(w,'/doingwave true def');
writeln(w,'displayentirepage');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/waveoff { % set the wave state off');
writeln(w,'/doingwave false def');
writeln(w,'displayentirepage');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/toggleprinting { % turn on or off printing');
writeln(w,'/printing printing not def');
writeln(w,'printing');
writeln(w,'{(Printing is on.) rpt}');
writeln(w,'{(Printing is suppressed.) rpt}');
writeln(w,'ifelse');
writeln(w,'displayentirepage');
writeln(w,'} bind def');
writeln(w,'/tp {toggleprinting} bind def');

writeln(w);
writeln(w,'/toggleerase { % turn on or off erase');
writeln(w,'/DoErasePage DoErasePage not def');
writeln(w,'DoErasePage');
writeln(w,'{(page erase is on.) rpt}');
writeln(w,'{(page erase is suppressed.) rpt}');
writeln(w,'ifelse');
writeln(w,'displayentirepage');
writeln(w,'} bind def');
writeln(w,'/te {toggleerase} bind def');

writeln(w);
writeln(w,'/togglereport { % turn on or off report');
writeln(w,'/doreport doreport not def');
writeln(w,'doreport');
writeln(w,'{/rpt { = } def}');
writeln(w,'{/rpt {pop} def}');
writeln(w,'ifelse');
writeln(w,'} bind def');
writeln(w,'/tr {togglereport} bind def');
(* make sure that the rpt function is defined at the current value: *)
writeln(w,'tr tr % define rpt according to current doreport');

writeln(w);
writeln(w,'% mutation controls:');

writeln(w,'/m {sequence exch get pstack pop} def');

writeln(w,'/mutate{ % ic base# mutate -');
writeln(w,'% store the base # at the internal coordinate ic in the sequence');
writeln(w,'/base exch def');
writeln(w,'/ic exch def');
writeln(w,'/ec sequence ic get 1 get def % external coordinate');
writeln(w,'sequence ic [base ec] put ');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/A { % external coordinate a - % set external coordinate to A');
writeln(w,'count 0 le');
writeln(w,'{(To use the "A" command to mutate base 10, type "10 A") rpt}');
writeln(w,'{ tointernal');
writeln(w,'  {0 mutate displayentirepage}');
writeln(w,'  {(That coordinate is not on this sequence) rpt}');
writeln(w,'  ifelse');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/C { % external coordinate a - % set external coordinate to C');
writeln(w,'count 0 le');
writeln(w,'{(To use the "C" command to mutate base 10, type "10 C") rpt}');
writeln(w,'{ tointernal');
writeln(w,'  {1 mutate displayentirepage}');
writeln(w,'  {(That coordinate is not on this sequence) rpt}');
writeln(w,'  ifelse');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/G { % external coordinate a - % set external coordinate to G');
writeln(w,'count 0 le');
writeln(w,'{(To use the "G" command to mutate base 10, type "10 G") rpt}');
writeln(w,'{ tointernal');
writeln(w,'  {2 mutate displayentirepage}');
writeln(w,'  {(That coordinate is not on this sequence) rpt}');
writeln(w,'  ifelse');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/T { % external coordinate a - % set external coordinate to T');
writeln(w,'count 0 le');
writeln(w,'{(To use the "T" command to mutate base 10, type "10 T") rpt}');
writeln(w,'{ tointernal');
writeln(w,'  {3 mutate displayentirepage}');
writeln(w,'  {(That coordinate is not on this sequence) rpt}');
writeln(w,'  ifelse');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'% @@@@@@@@@@@@@@@@@@@@@@@@');

writeln(w);
writeln(w,'/setrelativemutation { % set the relative mutation');
writeln(w,'% input: relative mutation');
writeln(w,'% output: boolean true = inside sequence');
writeln(w,'% output: spot = internal coordinate to modify');
writeln(w,' internalcoordinate add');
writeln(w,' /spot exch def');
writeln(w,' spot 0 ge');
writeln(w,' spot upperseq le');
writeln(w,' and');
writeln(w,'} def');

writeln(w);
writeln(w,'/a { % relative coordinate a - % set relative coordinate to a');
writeln(w,'count 0 le');
writeln(w,'{(To use the "a" command to mutate relative base +10,',
          ' type "10 a") rpt}');
writeln(w,'{ setrelativemutation');
writeln(w,'  {spot 0 mutate displayentirepage}');
writeln(w,'  {(That coordinate is not on this sequence) rpt}');
writeln(w,'  ifelse');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/c { % relative coordinate a - % set relative coordinate to c');
writeln(w,'count 0 le');
writeln(w,'{(To use the "c" command to mutate relative base +10,',
          ' type "10 c") rpt}');
writeln(w,'{ setrelativemutation');
writeln(w,'  {spot 1 mutate displayentirepage}');
writeln(w,'  {(That coordinate is not on this sequence) rpt}');
writeln(w,'  ifelse');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/g { % relative coordinate a - % set relative coordinate to g');
writeln(w,'count 0 le');
writeln(w,'{(To use the "g" command to mutate relative base +10,',
          ' type "10 g") rpt}');
writeln(w,'{ setrelativemutation');
writeln(w,'  {spot 2 mutate displayentirepage}');
writeln(w,'  {(That coordinate is not on this sequence) rpt}');
writeln(w,'  ifelse');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/t { % relative coordinate a - % set relative coordinate to t');
writeln(w,'count 0 le');
writeln(w,'{(To use the "T" command to mutate relative base +10,',
          ' type "10 t") rpt}');
writeln(w,'{ setrelativemutation');
writeln(w,'  {spot 3 mutate displayentirepage}');
writeln(w,'  {(That coordinate is not on this sequence) rpt}');
writeln(w,'  ifelse');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'% @@@@@@@@@@@@@@@@@@@@@@@@');

writeln(w);
writeln(w,'/setri { % set the ri bound');
writeln(w,'count 0 le');
writeln(w,'{(use setri to set the Ri bound; it needs a number in bits) rpt');
writeln(w,' (current value:) rpt ribound rpt}');
writeln(w,'{/ribound exch def');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w);
writeln(w,'/setz { % set the z bound');
writeln(w,'count 0 le');
writeln(w,'{(setz to set the z bound needs a number) rpt');
writeln(w,' (current value:) rpt zbound rpt}');
writeln(w,'{/zbound exch abs def');
writeln(w,'} ifelse');
writeln(w,'} bind def');

writeln(w,'/f { % search forward');
writeln(w,'count 0 le {1} if');
writeln(w,'dup 0 lt');
writeln(w,'  {abs b}'); (* a subtle trick: call the other if it's negative! *)
writeln(w,'  {{internalcoordinate 1');
writeln(w,'    sequencemoves {sub} {add} ifelse takestep searchtest} repeat}');
writeln(w,'ifelse');
writeln(w,'} def');

writeln(w,'/b { % search backward');
writeln(w,'count 0 le {1} if');
writeln(w,'dup 0 lt');
writeln(w,'  {abs f}'); (* a subtle trick: call the other if it's negative! *)
writeln(w,'  {{internalcoordinate 1');
writeln(w,'    sequencemoves {add} {sub} ifelse takestep searchtest} repeat}');
writeln(w,'ifelse');
writeln(w,'} def');

end;
(* end module defineusercommands *)

(* begin module PatentMessage *)
procedure PatentMessage(var f: text);
(* Write the patent message to file f
version = 3.02 of PatentMessage_module 2017 Jul 31
*)
procedure makebar;
begin
writeln(f,
'**********************************************************************');
end;
begin
makebar;
writeln(f,
'* By downloading this code you agree to the Source Code Use License: *');
writeln(f,
'* https://alum.mit.edu/www/toms/Source_Code_Use_License_Schneider.txt *');
writeln(f,
'* Contact: https://alum.mit.edu/www/toms/contacts.html                *');
makebar;
end;
(* end module PatentMessage version = 5.67; (@ of prgmod.p 2017 Sep 29 *)

(* begin module makewalker.themain *)
procedure themain(var book, ribl, colors, makewalkerp, walk: text);
(* the main procedure of the program *)
var
   p: parameters; (* the parameters to control the program *)
   riblmatrix: ribltypeptr; (* the weight matrix, Ri(b,l) *)
begin
   writeln(output,'makewalker ',version:4:2);

   PatentMessage(output);

   limitdate ('9','9','9','9','    /99/99 99:99:99');

   createheader(walk);

   readparameters(makewalkerp,p);

   (* read in the book and define the sequences in the walk *)
   makesequencearray(book, walk);

   (* read in the ribl and define the ribl array in the walk *)
   makeribl(ribl, walk, p.rangefrom, p.rangeto, riblmatrix);

   (* write the actual parameters out.  This allows makeribl
      to adjust the rangefrom and rangeto if necessary. *)
   writeparameters(walk, p);

   definitions(walk);
   varchardefs(walk, colors, showingbox, outline, shrinking);
   defineusercommands(walk);
   displayentirepage(walk);
   createender(makewalkerp, walk);

   (* report version of makewalker just before handing control
      over to the ghostview program.  This way a person
      can suppress all printing with a togglereport command *)
   writeln(walk);
   writeln(walk,'/version {(version = ',version:4:2,' of makewalker.p)} def');
   writeln(walk,'version rpt');
   writeln(walk,'(Documentation for this program is in makewalker.p) rpt');

   (* create end of EPS file *)
   writeln(walk,'%%Trailer');

end;
(* end module makewalker.themain *)

begin
   themain(book, ribl, colors, makewalkerp, walk);
1: end.
