*/
If you have a PH account, you can customize your PH profile.
*/

View \LIST3.PAS

Getting Started with the Pascal tutorial, source

Submitted By: WEBMASTER
Rating: (Not rated) (Rate It)


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

corner
© 1996-2008 CommunityHeaven LLC. All rights reserved. Reproduction in whole or in part, in any form or medium without express written permission is prohibited.
Violators of this policy may be subject to legal action. Please read our Terms Of Use and Privacy Statement for more information.
North American business development: Nicolai Wadstrom. Publisher: Lars Hagelin.