Category : Pascal Source Code
Archive   : PASTUT.ZIP
Filename : LIST3.PAS

(* 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 *)