program fileposition(input, fin, output);
(* fileposition: report the line that has a given file position

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

  National Cancer Institute
  Laboratory of Mathematical Biology

 *)

label 1; (* end of program *)

const
(* begin module version *)
version = 1.04; (* of fileposition.p 1996 March 24
origin 1996 February 8 *)
(* end module version *)

(* begin module describe.fileposition *)
(*
name
   fileposition: report the line that has a given file position

synopsis
   fileposition(input: in, fin: in, output: out)

files
   input:  a number, n, in characters and
           the number of characters before that point, the "prebuffer"
   fin:    a file
   output: the line in fin contining the n't character, with "prebuffer"
      characters printed before it.  This prebuffer allows one to see
      the context of the line.

description
   Ghostview reports locations of problems in characters.  In one case it
   objected to a stackoverflow in roll, but there is no roll in the code, so it
   would be nice to know the line number so I can get to it!

examples

documentation

see also

author
   Thomas Dana Schneider

bugs

technical notes

*)
(* end module describe.fileposition *)

(* begin module interact.const *)
      maxstring = 150; (* the maximum string *)
(* end module interact.const version = 4.15; (@ of prgmod.p 1994 November 12 *)
 
var
   fin: text; (* input file used by the program *)
 
type
(* begin module interact.type *)
      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 *)
      end;
(* end module interact.type version = 4.15; (@ of prgmod.p 1994 November 12 *)

(* 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.15; (@ of prgmod.p 1994 November 12 *)

(* begin module interact.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 *)
(* end module interact.clearstring version = 4.15; (@ of prgmod.p 1994 November 12 *)

(* begin module interact.getstring *)
procedure getstring(var afile: text; var buffer: string;
                    var gotten: boolean);
(* get 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.15; (@ of prgmod.p 1994 November 12 *)

(* begin module interact.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 interact.writestring version = 4.15; (@ of prgmod.p 1994 November 12 *)

(* begin module interact.flagstring *)
procedure flagstring(var afile: text; var buffer: string);
(* flag an error in the buffer at the current place, and clear the buffer *)
begin (* flagstring *)
      with buffer do length := current; (* chop off the rest of the buffer *)
      writestring(afile, buffer); (* show the buffer *)
      write(afile,'? ');
      clearstring(buffer)
end; (* flagstring *)
(* end module interact.flagstring *)

(* begin module fileposition.themain *)
procedure themain(var fin: text);
(* the main procedure of the program *)
var
   buffer: string;  (* a line of file fin *)
   done: boolean; (* did we find the line? *)
   gotten: boolean; (* did we get another line? *)
   i: integer; (* index to n *)
   j: integer; (* count of characters on a line *)
   n: integer; (* character to locate *)
   prebuffer: integer; (* number of characters to report before n *)
begin
   writeln(output,'fileposition ',version:4:2);

   writeln(output,'What file position do you want to see the line for? ');
   readln(input,n);
   writeln(output,'position: ',n:1);

   writeln(output,'How many characters do you want to see prior to the');
   writeln(output,'line at this position ("prebuffer")? ');
   readln(input,prebuffer);
   writeln(output,'prebuffer: ',prebuffer:1);
   writeln(output,'------------------');

   reset(fin);
   i := 0;
   done := false;
   while not done do begin
      getstring(fin,buffer,gotten);
      if gotten then begin
         i := i + buffer.length+1;

{
writeln(output,'i=',i:1);
writeln(output,'buffer.length', buffer.length:1);
}

{zzz +1?}
         if i >= n - prebuffer then begin
            writestring(output, buffer);
            writeln(output);
         end;


         if i >= n then begin
            writeln(output,'------------------');
            writestring(output, buffer);
            writeln(output);

            for j := 1 to buffer.length-(i-n) do write(output,' ');
            writeln(output,'^',n:1); 
            done := true

         end;
      end
      else done := true;
   end;
end;
(* end module fileposition.themain *)

begin
   themain(fin);
1: end.