program bndrec(bndrecp, bndmarks, output);
(* bndrec: create marks file for a boundrectangle

  Tom Schneider
  NCI/FCRDC Bldg 469. Room 144
  P.O. Box B
  Frederick, MD  21702-1201
  (301) 846-5581 (-5532 for messages)
  permanent email: toms@alum.mit.edu
  toms@ncifcrf.gov
  http://www.lecb.ncifcrf.gov/~toms/

  National Cancer Institute
  Laboratory of Experimental and Computational Biology

 *)

label 1; (* end of program *)

const
(* begin module version *)
version = 1.05; (* of bndrec.p 2000 March 27
1.00; 2000 March 23 origin *)
updateversion = 1.00; (* defines lowest acceptable current parameter file *)
(* end module version *)

(* begin module describe.bndrec *)
(*
name
   bndrec: create marks file for a boundrectangle

synopsis
   bndrec(bndrecp: in, bndmarks: out, output: out)

files

   bndmarks:  The marks for the lister program.  Concatenate this
      to the end of the marks.arrow file and put the result into the marks
      file for lister.

   bndrecp:  parameters to control the program.  The file must contain the
      following parameters, one per line:

      parameterversion: The version number of the program.  This allows the
         user to be warned if an old parameter file is used.

   output: messages to the user

description

   It is somewhat difficult to write the specific corners of boundrectangles
   as defined in marks.arrow.  This program takes a simple parameter file
   and creates the user defined marks.

examples

   The boundrectangle is called this way:

U   4000.0   -12.00    4019.0    -11.00       -217 boundrectangle

U says to lister to start working on a user defined mark
4000 is the left edge of the mark in bases
 -12 is the lower edge of the mark in bits
4019 is the right edge of the mark in bases
 -12 is the upper edge of the mark in bits
-217 is how far back the rectangle should be shifte in bases

The bndmarkp file creates this from:



documentation

see also

   {program that uses marks} lister.p

   {definition of boundrectangles:} marks.arrow {this MUST be before
   the bndmarks from this file.}

author

   Thomas Dana Schneider

bugs

technical notes


*)
(* end module describe.bndrec *)

var
   bndrecp, (* file used by this program *)
   bndmarks: text; (* file used by this program *)

(* 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 = 'delmod 6.16 84 mar 12 tds/gds'; *)

(* 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 = 7.42; {of delmod.p 2000 Mar 22} *)

(* begin module bndrec.themain *)
procedure themain(var bndrecp, bndmarks: text);
(* the main procedure of the program *)
const
   dec = 2; (* decimals of reals *)
   wid = 10; (* width of reals *)
   debug = false; (* true means give debug output *)

var
   bits: real; (* bits below or above the DNA line *)
   bitheight: real; (* height of rectangle *)
   counter: integer; (* for debugging *)
   displacement: real; (* displacement of the trigger point *)
   left: real; (* left edge *)
   parameterversion: real; (* parameter version number *)
   right: real; (* right edge *)
   skip: char; (* for skipping characters *)

begin
   writeln(output,'bndrec ',version:4:2);
   reset(bndrecp);
   readln(bndrecp, parameterversion);
   if parameterversion < updateversion then begin
      writeln(output, 'You have an old parameter file!');
      halt
   end;

   displacement := 0.0;
   bitheight := 1.0;

   rewrite(bndmarks);
   writeln(bndmarks,'* bndrec ',version:4:2);

if debug then counter := 0;
   while not eof(bndrecp) do begin
if debug then counter := succ(counter);
if debug then writeln(output,counter:1);
if debug then writeln(output,'bndrecp^ = "',bndrecp^,'"');
      if eoln(bndrecp)
      then readln(bndrecp)

      else if (bndrecp^ = 'd') then begin (* set displacement *)
         readln(bndrecp, skip, displacement);
         writeln(bndmarks,'* displacement: ',displacement:wid:dec);
      end

      else if (bndrecp^ = 'b') then begin (* set bits height *)
         readln(bndrecp, skip, bitheight);
         writeln(bndmarks,'* bitheight: ',bitheight:wid:dec);
      end

      else if (bndrecp^ = 'u') then begin (* set user definitions *)
         repeat
            copyaline(bndrecp, bndmarks);
            if eof(bndrecp) then begin
               writeln(output,'no end to user definition (u) found.');
               writeln(output,'you need to end it with a ''!''');
               halt;
            end;
if debug then writeln(output,'copying');
         until bndrecp^ = '!';
         copyaline(bndrecp, bndmarks); (* pass by the '!' *)
      end

      else if bndrecp^ = '*' then begin (* copy comment *)
         copyaline(bndrecp, bndmarks);
      end

      else begin
if debug then writeln(output,'reading left ...');

         readln(bndrecp, left, right, bits);
         if right < left then begin
            writeln(output,'all right coordinates must be greater than left');
            writeln(output,'*  left:',left:wid:dec);
            writeln(output,'* right:',right:wid:dec);
            halt;
         end;
         writeln(bndmarks);
         writeln(bndmarks,'*  left:',left:wid:dec);
         writeln(bndmarks,'* right:',right:wid:dec);

         writeln(bndmarks, 'U',
                ' ',displacement:wid:dec,
                ' ',bits:wid:dec,
                ' ',(displacement+right - left):wid:dec,
                ' ',(bits+bitheight):wid:dec,
                ' ',(2*(left-displacement)):wid:dec,
                ' boundrectangle');

         displacement := displacement + 1.0;
      end

   end;

(*
U   4000.0   -12.00    4019.0    -11.00       -217 boundrectangle
U   4001.0   -13.00    4040.0    -12.00       -217 boundrectangle
*)

end;
(* end module bndrec.themain *)

begin
   themain(bndrecp, bndmarks);
1: end.