home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / PASTUT24.ZIP / PTUTRSRC.ZIP / LIST3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-12-01  |  3.6 KB  |  121 lines
  1.                                      (* Chapter 14 - Program 6 *)
  2. program List_Pascal_Source_Files;    (* For TURBO Pascal 3.0 only *)
  3.  
  4. const Max_Lines_Per_Page = 50;
  5.  
  6. type Command_String = string[127];
  7.  
  8. var Input_File      : text;
  9.     Input_Line      : array[1..140] of char;
  10.     Line_Number     : integer;
  11.     Lines_Printed   : integer;
  12.     Page_No         : integer;
  13.     Index           : integer;
  14.     Command_In      : Command_String absolute Cseg:$80;
  15.     Command_Temp    : Command_String;
  16.     Command         : Command_String;
  17.  
  18. procedure Initialize; (* ****************************** initialize *)
  19. begin
  20.    Command := '';
  21.    Command_Temp := Command_In;  (* leave the input area unchanged *)
  22.    while (Length(Command_Temp) > 0) and (Command_Temp[1] = ' ') do
  23.       Delete(Command_Temp,1,1);
  24.    while (Length(Command_Temp) > 0) and (Command_Temp[1] <> ' ') do
  25.    begin
  26.       Command := Command + Command_Temp[1];
  27.       Delete(Command_Temp,1,1);
  28.    end;
  29.    Assign(Input_File,Command);
  30.    Reset(Input_File);
  31.    Line_Number := 1;
  32.    Lines_Printed := 66; (* This is to force a header immediately *)
  33.    Page_No := 1;
  34. end;
  35.  
  36. procedure Read_A_Line; (* **************************** read a line *)
  37. begin
  38.    for Index := 1 to 140 do Input_Line[Index] := ' ';
  39.    Readln(Input_File,Input_Line);
  40. end;
  41.  
  42. procedure Format_And_Display; (* **************** format and display *)
  43.  
  44. var Line_Length : byte;
  45.  
  46. begin
  47.    Write(Line_Number:6,'  ');
  48.    for Index := 1 to 140 do begin
  49.       if Input_Line[Index] <> ' ' then Line_Length := Index;
  50.    end;
  51.    if Line_Length <= 70 then begin           (* line length less *)
  52.       for Index := 1 to Line_Length do     (* than 70 characters *)
  53.          Write(Input_Line[Index]);
  54.       Writeln;
  55.    end
  56.    else begin             (* line length more than 70 characters *)
  57.       for Index := 1 to 70 do
  58.          Write(Input_Line[Index]);
  59.       Writeln('<');
  60.       Write('        ');
  61.       for Index := 71 to Line_Length do
  62.          Write(Input_Line[Index]);
  63.       Writeln;
  64.    end;
  65. end;
  66.  
  67. procedure Format_And_Print; (* ****************** format and print *)
  68.  
  69. var Line_Length : byte;
  70.  
  71. begin
  72.    Write(Lst,Line_Number:6,'  ');
  73.    for Index := 1 to 140 do begin
  74.       if Input_Line[Index] <> ' ' then Line_Length := Index;
  75.    end;
  76.    if Line_Length <= 70 then begin         (* line length less *)
  77.       for Index := 1 to Line_Length do   (* than 70 characters *)
  78.          Write(Lst,Input_Line[Index]);
  79.       Writeln(Lst);
  80.       Lines_Printed := Lines_Printed + 1;
  81.    end
  82.    else begin           (* line length more than 70 characters *)
  83.       for Index := 1 to 70 do
  84.          Write(Lst,Input_Line[Index]);
  85.       Writeln(Lst,'<');
  86.       Write(Lst,'        ');
  87.       for Index := 71 to Line_Length do
  88.          Write(Lst,Input_Line[Index]);
  89.       Writeln(Lst);
  90.       Lines_Printed := Lines_Printed + 2;
  91.    end;
  92.    Line_Number := Line_Number + 1;
  93. end;
  94.  
  95. procedure Check_For_Page; (* ********************** check for page *)
  96. begin
  97.    if Lines_Printed > Max_Lines_Per_Page then begin
  98.       if Page_No > 1 then
  99.          Writeln(Lst,Char(12));
  100.       for Index := 1 to 3 do
  101.          Writeln(Lst);
  102.       Write(Lst,'     ');
  103.       Writeln(Lst,'Source file ',Command,'Page':24,Page_No:4);
  104.       Page_No := Page_No + 1;
  105.       Lines_Printed := 1;
  106.       Writeln(Lst);
  107.    end;
  108. end;
  109.  
  110. begin  (* ******************************************* main program *)
  111.    Initialize;
  112.    Check_For_Page;
  113.    repeat
  114.       Read_A_Line;
  115.       Format_And_Display;
  116.       Format_And_Print;
  117.       Check_For_Page;
  118.    until Eof(Input_File);
  119.    Writeln(Lst,Char(12));
  120. end.  (* of main program *)
  121.