program center(input, centerp, output);
(* center: center text lines

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

  National Cancer Institute
  Laboratory of Mathematical Biology

  1994
 *)

label 1; (* end of program *)

const
(* begin module version *)
version = 1.08; (* of center.p 1994 April 15
origin 1994 April 15 *)
(* end module version *)

(* begin module describe.center *)
(*
name
   center: center text lines

synopsis
   center(input: in, centerp: in, output: out)

files
   input:  A text file to be centered
   centerp:  one integer: location of the center in characters
   output: The centered text file

description
   The program reads lines of text and outputs them centered around whatever
   point requested.  If the text is too long, it is left alone.

examples
   with centering at 10,

these lines
of
text
will become:

    these lines
         of
        text
    will become:

documentation

see also

author
   Thomas Dana Schneider

bugs
   The longest possible line is defined by constant maxstring.

technical notes

*)
(* end module describe.center *)

(* begin module interact.const *)
      maxstring = 150; (* the maximum string *)
(* end module interact.const version = 4.12; (@ of prgmod.p 1993 Mar 26 *)
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.12; (@ of prgmod.p 1993 Mar 26 *)
 
var
   centerp: 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.12; (@ of prgmod.p 1993 Mar 26 *)


(* 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.12; (@ of prgmod.p 1993 Mar 26 *)

(* 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.12; (@ of prgmod.p 1993 Mar 26 *)

(* 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.12; (@ of prgmod.p 1993 Mar 26 *)

(* begin module center.themain *)
procedure themain(var centerp: text);
(* the main procedure of the program *)
const
   debug = false; (* whether to debug the program *)
var
   b: integer; (* index to buffer *)
   buffer: string; (* a line of text *)
   done: boolean; (* done operating on the line *)
   first: integer; (* first non blank character on the line *)
   gotten: boolean; (* whether we got the line of text *)
   last: integer; (* last non blank character on the line *)
   length: integer; (* length of the buffer that is surrounded by blanks *)
   thecenter: integer; (* the requested center of the text *)
begin
   if debug then writeln(output,'center ',version:4:2);
   reset(centerp);
   readln(centerp, thecenter);

   if debug then writeln(output,'centering at ',thecenter:1);

   while not eof(input) do begin
      getstring(input,buffer,gotten);
      if gotten then begin
         if buffer.length = 0 then begin
            writeln(output);
         end
         else begin
            if debug then write(output,'"');
            if debug then writestring(output,buffer);
            if debug then writeln(output,'"');

            (* find the first non blank characters in the string *)
            first := 1;
            done := false;
            while not done do begin
               if buffer.letters[first] = ' ' 
               then first := succ(first)
               else done := true;
               if first >= buffer.length then done := true;
            end;

            (* find the last non blank characters in the string *)
            last := buffer.length;
            done := false;
            while not done do begin
               if buffer.letters[last] = ' '
               then last := pred(last)
               else done := true;
               if last <= 1 then done := true;
            end;

            if debug then writeln(output,'first: ',first:1);
            if debug then writeln(output,'last: ',last:1);

            if debug then write(output,' ');
            if debug then for b := 1 to buffer.length
               do   if b = first then write(output,'F')
               else if b = last  then write(output,'L')
               else                   write(output,' ');
            if debug then writeln(output,' ');

            if debug then write(output,'"');
            if debug then writestring(output,buffer);
            if debug then writeln(output,'"');

            length := last - first + 1;
            if debug then writeln(output,'length = ',length:1);

            if length > 0 then begin
               (* put leading blanks as needed *)
               for b := 1 to (thecenter - round(length/2))
               do write(output,' ');

               (* reduce buffer to remove final blanks: *)
               buffer.length := last;
               if debug then write(output,'"');
               for b := first to last do write(output,buffer.letters[b]);
               if debug then write(output,'"');
            end;
            writeln(output);
         end;
         if debug then writeln(output,'--------------------------------------');
      end;
   end;
   
end;
(* end module center.themain *)
begin
   themain(centerp);
1: end.