program column(input, columnp, output);
(* column: pull defined column from input

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

 *)

label 1; (* end of program *)

const
(* begin module version *)
   version = 1.06; (* of column.p 2005 Sep 13
2005 Sep 13, 1.06 upgrade documentation
2000 Jan 16, 1.05 upgrade documentation
1993 Sep  8, 1.04 previous changes
origin 1992 September 15 *)
(* end module version *)

(* begin module describe.column *)
(*
name
   column: pull defined column from input

synopsis
   column(input: in, columnp: in, output: out)

files

   input:  file with several columns of data separated by spaces
      lines that begin with asterisk, '*', are copied to output.
      These are comment lines for genhis and xyplo.

   columnp: parameters:  one line containing one integer:  which column to
      extract

   output: messages to the user

description

   The column program allows one to extract columns from a dataset.
   Lines in input that start with '*' are simply copied to the output.

examples

documentation

see also

   {Programs that use the same column conventions:}
   xyplo.p
   genhis.p

author

   Thomas Dana Schneider

bugs

technical notes

*)
(* end module describe.column *)

var
   columnp: text; (* a 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 = 4.11; (@ of prgmod.p 1991 Apr 22 *)

(* 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 = 4.11; (@ of prgmod.p 1991 Apr 22 *)

(* begin module skipblanks *)
procedure skipblanks(var thefile: text);
(* skip over blanks until a non-blank, or end of line, is found *)
begin
      while (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 (thefile^ <> ' ') and not eoln(thefile) do get(thefile);
end;
(* end module skipblanks version = 4.11; (@ of prgmod.p 1991 Apr 22 *)

(* begin module copynonblanks *)
procedure copynonblanks(var infile, outfile: text);
(* copy nonblanks until a blank, or end of line, is found *)
begin
   skipblanks(infile);
   while (infile^ <> ' ') and not eoln(infile) do begin
      outfile^ := infile^;
      put(outfile);
      get(infile);
   end;
end;
(* end module copynonblanks *)

(* begin module column.themain *)
procedure themain(var fin, columnp, fout: text);
(* the main procedure of the program *)
var
   c: integer; (* current column *)
   whichone: integer; (* desired column *)
begin
{
   writeln(output,'column ',version:4:2);
}
   reset(columnp);
   readln(columnp, whichone);
{
   (* it's not a good idea to reset the input file! *)
   reset(fin);

   (* it's not a good idea to rewrite the output file! *)
   rewrite(fout);
}

   while not eof(fin) do begin
      if fin^ = '*'
      then begin
         copyaline(fin,fout)
      end
      else begin
         c := 1; 
         skipblanks(fin);
         while c < whichone do begin 
            skipnonblanks(fin);
            skipblanks(fin);
            c := succ(c)
         end;
{
         if the program does multiple columns later, this will be needed:
         write(fout,' ');
}
         copynonblanks(fin, fout);
         writeln(fout);
         readln(fin);
      end;
   end;
end;
(* end module column.themain *)

begin
   themain(input, columnp, output);
1: end.