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