program nomultiblank(input, output);
(* nomultiblank: remove all multiple blank lines from a file

  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.00; (* of nomultiblank.p 2006 Nov 25
origin 2006 Nov 25 from noblank *)
updateversion = 1.00; (* defines lowest acceptable current parameter file *)
(* end module version *)

(* begin module describe.nomultiblank *)
(*
name
   nomultiblank: remove all multiple blank lines from a file

synopsis
   nomultiblank(input: in, out, output: out)

files
   input:  a text file

   output: the text file with multile blank lines in the middle
      replaced by a single blank line.

description

   This program will remove multiple blanks lines in the middle of a
   file.  It will also remove lines that have only blank characters.

examples

documentation

see also
   rembla.p noblank.p

author
   Thomas Dana Schneider

bugs

technical notes

*)
(* end module describe.nomultiblank *)

{
(* 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 nomultiblank.themain *)
procedure themain(var fin, fout: text);
(* the main procedure of the program *)
const
   debugging = false; (* set true to see counts *)
var
   c: char; (* a character in fin *)
   b: integer; (* index to blanks *)
   blanks: integer; (* number of leading blank characters *)
   blankline: boolean; (* the line was totally blank *)
   countblanklines: integer; (* count of the blank lines *)
begin
   countblanklines := 0;
   while not eof(fin) do begin
      blanks := 0;
      blankline := true;
      while not eoln(fin) do begin
         read(fin,c);
         if (c = ' ') and (blankline) then begin
            blanks := succ(blanks)
         end
         else begin
            blankline := false;
            countblanklines := 0;
            for b := 1 to blanks do write(fout,' ');
            blanks := 0;
         end;
         if not blankline then write(fout,c);
      end;
      readln(fin);
      countblanklines := countblanklines + 1;
      if debugging then write(fout, '[',countblanklines:1,']');
      if countblanklines <= 2 then begin
         writeln(fout);
      end
      else begin
      end;
   end

end;
(* end module nomultiblank.themain *)

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