program fv(input, output);
(* fv: flip lines of a file vertically

  Thomas D. Schneider, Ph.D.
  Senior Investigator
  National Institutes of Health
  National Cancer Institute
  Gene Regulation and Chromosome Biology Laboratory
  Molecular Information Theory Group
  Frederick, Maryland  21702-1201
  301-846-5581
  schneidt@mail.nih.gov
  toms@alum.mit.edu (permanent)
  http://alum.mit.edu/www/toms (permanent)

 *)

label 1; (* end of program *)

const
(* begin module version *)
   version = 1.01; (* of fv.p 2012 Apr 05
2012 Apr 05, 1.01: tail -r does the same!
2007 May 19, 1.00: origin from version 2.00 of rv. *)
(* end module version *)

(* begin module describe.fv *)
(*
name
   fv: flip lines of a file vertically

synopsis
   fv(input: in, output: out)

files

   input:  a text file

   output: each line of the input is typed backwards

description

   Lines of the input are read in, stored and put out in the reverse
   order vertically.

examples

documentation

see also

   rv.p

author

   Thomas Dana Schneider

bugs

technical notes

2012 Apr 05:  I discovered that
   tail -r
performs the same function as this program!

*)
(* end module describe.fv *)

(* begin LOCKED module string.const *)
   maxstring = 1000; (* the maximum string *)
(* end LOCKED module string.const version = 4.41; (@ of prgmod.p 2000 June 24 *)

type
(* begin module string.type *)
   stringptr = ^string; (* pointer to a string *)
   string = record (* a string of characters *)
      letters: array[1..maxstring] of char; (* the letters in the string *)
      length: integer; (* the number of characters in the string *)
      current: integer; (* the letter we are working on *)
      next: stringptr; (* the next string in a series *)
   end;
(* end module string.type version = 4.41; (@ of prgmod.p 2000 June 24 *)

(* 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 clearstring *)
procedure clearstring(var ribbon: string);
(* empty the string *)
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; (* clearstring *)
procedure initializestring(var ribbon: string);
(* start the string with a nil pointer.   This routine
should be called before doing linked list work.  This allows
the standard string routines to clear the string without
killing the pointer. *)
begin (* initializestring *)
   clearstring(ribbon);
   ribbon.next := nil;
end; (* initializestring *)
(* end module clearstring version = 4.41; (@ of prgmod.p 2000 June 24 *)

(* 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 = 4.41; (@ of prgmod.p 2000 June 24 *)

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

(* begin module reversestring *)
procedure reversestring(instring: string; var outstring: string);
(* reverse the instring around to the out string *)
var
   i: integer; (* index to the instring *)
begin
   initializestring(outstring);
   outstring.length := instring.length;
   for i := 1 to instring.length
   do outstring.letters[instring.length - i + 1] := instring.letters[i]
end;
(* end module reversestring *)

(* begin module fv.themain *)
procedure themain(var fin, fout: text);
(* the main procedure of the program *)
var
   lineptr: stringptr; (* a line of text *)
   first: boolean; (* first pass into the data *)
   gotten: boolean; (* did we get the line of text? *)
   all: stringptr; (* pointer to all strings *)
   n: integer; (* counter of lines *)
begin
   new(lineptr);
   initializestring(lineptr^);
   all := lineptr;
   first := true;

   reset(fin);
   while not eof(fin) do begin
      getstring(fin, lineptr^, gotten);
      if gotten then begin
         if not first then lineptr^.next := all;
         first := false;
         all := lineptr;
         new(lineptr);
         initializestring(lineptr^);
      end;
   end;

   n := 0;
   lineptr := all;
   while lineptr <> nil do begin
      writestring(fout, lineptr^);
      writeln(fout);
      lineptr := lineptr^.next;
{ for testing: 
      if n > 20 then halt;
}
      n := n + 1;
   end;
end;
(* end module fv.themain *)

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