(* Chapter 14 - Program 6 *)
program List_Pascal_Source_Files;    (* For TURBO Pascal 3.0 only *)

const Max_Lines_Per_Page = 50;

type Command_String = string[127];

var Input_File      : text;
    Input_Line      : array[1..140] of char;
    Line_Number     : integer;
    Lines_Printed   : integer;
    Page_No         : integer;
    Index           : integer;
    Command_In      : Command_String absolute Cseg:$80;
    Command_Temp    : Command_String;
    Command         : Command_String;

procedure Initialize; (* ****************************** initialize *)
begin
   Command := '';
   Command_Temp := Command_In;  (* leave the input area unchanged *)
   while (Length(Command_Temp) > 0) and (Command_Temp[1] = ' ') do
      Delete(Command_Temp,1,1);
   while (Length(Command_Temp) > 0) and (Command_Temp[1] <> ' ') do
   begin
      Command := Command + Command_Temp[1];
      Delete(Command_Temp,1,1);
   end;
   Assign(Input_File,Command);
   Reset(Input_File);
   Line_Number := 1;
   Lines_Printed := 66; (* This is to force a header immediately *)
   Page_No := 1;
end;

procedure Read_A_Line; (* **************************** read a line *)
begin
   for Index := 1 to 140 do Input_Line[Index] := ' ';
   Readln(Input_File,Input_Line);
end;

procedure Format_And_Display; (* **************** format and display *)

var Line_Length : byte;

begin
   Write(Line_Number:6,'  ');
   for Index := 1 to 140 do begin
      if Input_Line[Index] <> ' ' then Line_Length := Index;
   end;
   if Line_Length <= 70 then begin           (* line length less *)
      for Index := 1 to Line_Length do     (* than 70 characters *)
         Write(Input_Line[Index]);
      Writeln;
   end
   else begin             (* line length more than 70 characters *)
      for Index := 1 to 70 do
         Write(Input_Line[Index]);
      Writeln('<');
      Write('        ');
      for Index := 71 to Line_Length do
         Write(Input_Line[Index]);
      Writeln;
   end;
end;

procedure Format_And_Print; (* ****************** format and print *)

var Line_Length : byte;

begin
   Write(Lst,Line_Number:6,'  ');
   for Index := 1 to 140 do begin
      if Input_Line[Index] <> ' ' then Line_Length := Index;
   end;
   if Line_Length <= 70 then begin         (* line length less *)
      for Index := 1 to Line_Length do   (* than 70 characters *)
         Write(Lst,Input_Line[Index]);
      Writeln(Lst);
      Lines_Printed := Lines_Printed + 1;
   end
   else begin           (* line length more than 70 characters *)
      for Index := 1 to 70 do
         Write(Lst,Input_Line[Index]);
      Writeln(Lst,'<');
      Write(Lst,'        ');
      for Index := 71 to Line_Length do
         Write(Lst,Input_Line[Index]);
      Writeln(Lst);
      Lines_Printed := Lines_Printed + 2;
   end;
   Line_Number := Line_Number + 1;
end;

procedure Check_For_Page; (* ********************** check for page *)
begin
   if Lines_Printed > Max_Lines_Per_Page then begin
      if Page_No > 1 then
         Writeln(Lst,Char(12));
      for Index := 1 to 3 do
         Writeln(Lst);
      Write(Lst,'     ');
      Writeln(Lst,'Source file ',Command,'Page':24,Page_No:4);
      Page_No := Page_No + 1;
      Lines_Printed := 1;
      Writeln(Lst);
   end;
end;

begin  (* ******************************************* main program *)
   Initialize;
   Check_For_Page;
   repeat
      Read_A_Line;
      Format_And_Display;
      Format_And_Print;
      Check_For_Page;
   until Eof(Input_File);
   Writeln(Lst,Char(12));
end.  (* of main program *)