home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / modula2 / mod2src.arc / LIST.MOD < prev    next >
Encoding:
Text File  |  1987-03-25  |  7.2 KB  |  223 lines
  1. MODULE List;   (* Program to list Modula-2 source files with page  *)
  2.                (* numbers and line numbers.                        *)
  3.  
  4. FROM FileSystem IMPORT Lookup, Close, File, ReadChar, Response,
  5.                        WriteChar;
  6. FROM Conversions IMPORT ConvertCardinal;
  7. FROM TimeDate IMPORT GetTime, Time;
  8. IMPORT ASCII;
  9. IMPORT InOut;
  10.  
  11. TYPE BigString   = ARRAY[1..80] OF CHAR;
  12.      SmallString = ARRAY[1..25] OF CHAR;
  13.  
  14. VAR InFile     : File;          (* The Input File record            *)
  15.     Printer    : File;          (* The Printer File record          *)
  16.     NameOfFile : SmallString;   (* Storage for the filename         *)
  17.     InputLine  : BigString;     (* The Input line of characters     *)
  18.     LineNumber : CARDINAL;      (* The current line number          *)
  19.     LinesOnPage : CARDINAL;     (* Number of Lines on this page     *)
  20.     PageNumber  : CARDINAL;     (* Page Number                      *)
  21.     Index       : CARDINAL;     (* Used locally in several proc's   *)
  22.     Year,Day,Month     : CARDINAL;
  23.     Hour,Minute,Second : CARDINAL;
  24.     GoodFile    : BOOLEAN;
  25.  
  26. (* ************************************************ WriteCharString *)
  27. (* Since there is no WriteString procedure in the FileSystem        *)
  28. (* module, this procedure does what it would do.  It outputs a      *)
  29. (* string until it comes to the end of it or until it comes to a    *)
  30. (* character 0.                                                     *)
  31. PROCEDURE WriteCharString(CharString : ARRAY OF CHAR);
  32. BEGIN
  33.    Index := 0;
  34.    LOOP
  35.       IF Index > HIGH(CharString) THEN EXIT END; (* Max = 80 chars  *)
  36.       IF CharString[Index] = 0C THEN EXIT END;   (* If a 0C is found*)
  37.       WriteChar(Printer,CharString[Index]);
  38.       INC(Index);
  39.    END;
  40. END WriteCharString;
  41.  
  42.  
  43. (* ************************************************* WriteLnPrinter *)
  44. (* Since there is no WriteLn procedure in the FileSystem module,    *)
  45. (* procedure does its job.                                          *)
  46. PROCEDURE WriteLnPrinter;
  47. CONST CRLF = 12C;
  48. BEGIN
  49.    WriteChar(Printer,CRLF);
  50. END WriteLnPrinter;
  51.  
  52.  
  53. (* ************************************************* GetFileAndOpen *)
  54. (* This procedure requests the filename, receives it, and opens the *)
  55. (* source file for reading and printing.  It loops until a valid    *)
  56. (* filename is found.                                               *)
  57. PROCEDURE GetFileAndOpen(VAR GoodFile : BOOLEAN);
  58. BEGIN
  59.    InOut.WriteLn;
  60.    InOut.WriteString("Name of file to print ---> ");
  61.    InOut.ReadString(NameOfFile);
  62.    Lookup(InFile,NameOfFile,FALSE);
  63.    IF InFile.res = done THEN
  64.       GoodFile := TRUE;
  65.       Lookup(Printer,"PRN",TRUE);            (* open printer as a file *)
  66.    ELSE
  67.       GoodFile := FALSE;
  68.       InOut.WriteString("   File doesn't exist");
  69.       InOut.WriteLn;
  70.    END;
  71. END GetFileAndOpen;
  72.  
  73.  
  74. (* ***************************************************** Initialize *)
  75. (* This procedure initializes some of the counters.                 *)
  76. PROCEDURE Initialize;
  77. VAR PackedTime : Time;
  78. BEGIN
  79.    LineNumber := 1;
  80.    LinesOnPage := 0;
  81.    PageNumber := 1;
  82.    GetTime(PackedTime);
  83.    Day := PackedTime.day MOD 32;
  84.    Month := PackedTime.day DIV 32;
  85.    Month := Month MOD 16;
  86.    Year := 1900 + PackedTime.day DIV 512;
  87.    Hour := PackedTime.minute DIV 60;
  88.    Minute := PackedTime.minute MOD 60;
  89.    Second := PackedTime.millisec DIV 1000;
  90. END Initialize;
  91.  
  92.  
  93. (* *********************************************** PrintTimeAndDate *)
  94. (* This procedure prints the time and date at the top of every page *)
  95. PROCEDURE PrintTimeAndDate;
  96. VAR OutChars : ARRAY[0..4] OF CHAR;
  97. BEGIN
  98.    WriteCharString("      ");
  99.    ConvertCardinal(Hour,2,OutChars);
  100.    WriteCharString(OutChars);
  101.    WriteCharString(":");
  102.    ConvertCardinal(Minute,2,OutChars);
  103.    WriteCharString(OutChars);
  104.    WriteCharString(":");
  105.    ConvertCardinal(Second,2,OutChars);
  106.    WriteCharString(OutChars);
  107.    WriteCharString("  ");
  108.    ConvertCardinal(Month,2,OutChars);
  109.    WriteCharString(OutChars);
  110.    WriteCharString("/");
  111.    ConvertCardinal(Day,2,OutChars);
  112.    WriteCharString(OutChars);
  113.    WriteCharString("/");
  114.    ConvertCardinal(Year,4,OutChars);
  115.    WriteCharString(OutChars);
  116. END PrintTimeAndDate;
  117.  
  118.  
  119. (* *************************************************** OutputHeader *)
  120. (* This procedure prints the filename at the top of each page along *)
  121. (* with the page number.                                            *)
  122. PROCEDURE OutputHeader;
  123. VAR PageOut : ARRAY[1..4] OF CHAR;
  124. BEGIN
  125.    WriteCharString("   Filename --> ");
  126.    WriteCharString(NameOfFile);
  127.    WriteCharString("           ");
  128.    PrintTimeAndDate;
  129.    WriteCharString("   Page");
  130.    ConvertCardinal(PageNumber,4,PageOut);
  131.    WriteCharString(PageOut);
  132.    WriteLnPrinter;
  133.    WriteLnPrinter;
  134.    INC(PageNumber);
  135. END OutputHeader;
  136.  
  137.  
  138. (* *************************************************** OutputFooter *)
  139. (* This procedure outputs 8 blank lines at the bottom of each page. *)
  140. PROCEDURE OutputFooter;
  141. BEGIN
  142.    FOR Index := 1 TO 8 DO
  143.       WriteLnPrinter;
  144.    END;
  145. END OutputFooter;
  146.  
  147.  
  148. (* ******************************************************* GetALine *)
  149. (* This procedure inputs a line from the source file.  It quits when*)
  150. (* it finds an end-of-line, an end-of-file, or after it gets 80     *)
  151. (* characters.                                                      *)
  152. PROCEDURE GetALine;
  153. VAR LocalChar : CHAR;
  154. BEGIN
  155.    FOR Index := 1 TO 80 DO      (* clear the input area so that the *)
  156.       InputLine[Index] := 0C;   (* search for 0C will work.         *)
  157.    END;
  158.  
  159.    Index := 1;
  160.    LOOP
  161.       ReadChar(InFile,LocalChar);
  162.       IF InFile.eof THEN EXIT END;
  163.       InputLine[Index] := LocalChar;
  164.       IF LocalChar = ASCII.EOL THEN EXIT END;
  165.       INC(Index);
  166.       IF Index = 81 THEN EXIT END;
  167.    END;
  168. END GetALine;
  169.  
  170.  
  171. (* ***************************************************** OutputLine *)
  172. (* Output a line of test with the line number in front of it, after *)
  173. (* checking to see if the page is full.                             *)
  174. PROCEDURE OutputLine;
  175. VAR Count       : CARDINAL;
  176.     CardOutArea : ARRAY[1..8] OF CHAR;
  177. BEGIN
  178.    INC(LinesOnPage);
  179.    IF LinesOnPage > 56 THEN
  180.       OutputFooter;
  181.       OutputHeader;
  182.       LinesOnPage := 1;
  183.    END;
  184.    ConvertCardinal(LineNumber,6,CardOutArea);
  185.    INC(LineNumber);
  186.    WriteCharString(CardOutArea);
  187.    WriteCharString("  ");
  188.    WriteCharString(InputLine);
  189. END OutputLine;
  190.  
  191.  
  192. (* *************************************************** SpacePaperUp *)
  193. (* At the end of the listing, space the paper up so that a new page *)
  194. (* is ready for the next listing.                                   *)
  195. PROCEDURE SpacePaperUp;
  196. VAR Count : CARDINAL;
  197. BEGIN
  198.    Count := 64 - LinesOnPage;
  199.    FOR Index := 1 TO Count DO
  200.       WriteLnPrinter;
  201.    END;
  202.    Close(InFile);
  203.    Close(Printer);
  204. END SpacePaperUp;
  205.  
  206.  
  207. (* *************************************************** Main Program *)
  208. (* This is nothing more than a big loop.  It needs no comment.      *)
  209. BEGIN
  210.    GetFileAndOpen(GoodFile);
  211.    IF GoodFile THEN
  212.       Initialize;
  213.       OutputHeader;
  214.       REPEAT
  215.          GetALine;
  216.          IF NOT InFile.eof THEN
  217.             OutputLine;
  218.          END;
  219.       UNTIL InFile.eof;
  220.       SpacePaperUp;
  221.    END;
  222. END List.
  223.