home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol022 / linenos.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  3.7 KB  |  162 lines
  1. {++++++++++++++++++++++++++++++++++++++++++++++++}
  2. {+  PROGRAM TITLE:    Line Number        +}
  3. {+                        +}
  4. {+  WRITTEN BY:        Raymond E. Penley    +}
  5. {+  DATE WRITTEN:    23 July 1980        +}
  6. {+                        +}
  7. {+  WRITTEN FOR:    Pascal/Z Users Group    +}
  8. {+                        +}
  9. {+  SUMMARY:                    +}
  10. {+    Simple program to read in a text file    +}
  11. {+    (such as a program), and WRITE out to    +}
  12. {+    another file adding line numbers to    +}
  13. {+    each line processed.            +}
  14. {+                        +}
  15. {++++++++++++++++++++++++++++++++++++++++++++++++}
  16. PROGRAM LINENOS;
  17. (*$P-,F-,M- *)
  18. CONST
  19.     default    = 255;
  20.     left_margin = 5;
  21.     MaxLineLength = default;
  22.     space = ' ';
  23. TYPE
  24.     S$0    = string 0;
  25.     S$255    = string 255;
  26. VAR
  27.     blankcount    : INTEGER;
  28.     charcount    : INTEGER;
  29.     con_wanted    : BOOLEAN;
  30.     ch        : char;
  31.     fatal_error    : BOOLEAN;
  32.     FOUT,
  33.     FIN        : TEXT;
  34.     linecount    : INTEGER;
  35.     other        : INTEGER;
  36.     tab        : CHAR;
  37.     wordcount    : INTEGER;
  38.  
  39. (*$C- *)
  40. FUNCTION length(x: S$255):INTEGER;EXTERNAL;
  41. FUNCTION index(x,y: S$255): INTEGER; EXTERNAL;
  42. PROCEDURE setlength(VAR x:S$0; y:INTEGER);EXTERNAL;
  43.  
  44. PROCEDURE Summary;
  45. BEGIN
  46.   WRITELN('Line count .......... ', linecount-1:3);
  47.   WRITELN('No. of spaces ....... ', blankcount:3);
  48.   WRITELN('No. of characters ... ', charcount:3);
  49.   WRITELN;
  50. END;
  51.  
  52. PROCEDURE GetC(VAR ch: char);
  53. BEGIN
  54.   IF NOT EOF(FIN) THEN
  55.     READ(FIN,ch);
  56.   IF EOF(FIN) THEN ch := ' ';
  57. END;
  58.  
  59. PROCEDURE Classify(VAR ch: CHAR);
  60. BEGIN
  61.   IF ch IN ['A'..'Z','a'..'z'] THEN
  62.      charcount := SUCC(charcount)
  63.   ELSE IF (ch=space) THEN
  64.      blankcount := SUCC(blankcount)
  65.   ELSE
  66.      other := SUCC(other);
  67. END;
  68.  
  69. PROCEDURE ConnectFiles;
  70. const
  71.     fid_len    = 14;    { Max length CP/M file names }
  72. type    FID    = string fid_len;
  73.     byte    = 0..255;
  74. var    firstname,
  75.     fname  : FID;
  76.     ix,jx    : byte;
  77.  
  78.     Procedure PAD(var ID: fid; required: byte);
  79.     const    space = ' ';
  80.     BEGIN
  81.       while (length(ID)<required) Do append(ID,space);
  82.     end;
  83.  
  84. BEGIN{-GETID-}
  85.   fatal_error := FALSE;
  86.   setlength(firstname,0);
  87.   WRITELN;
  88.   WRITE('Enter <Drive:><File name>  ');
  89.   readln(firstname);
  90.   IF (length(firstname)>fid_len) then
  91.     setlength(firstname,fid_len)
  92.   ELSE
  93.     PAD(firstname, fid_len);
  94.   RESET(firstname, FIN);
  95.  
  96.   IF EOF(FIN) THEN {ABORT}
  97.     BEGIN
  98.     WRITELN('FILE NOT FOUND');
  99.     fatal_error := TRUE;
  100.     END
  101.   ELSE
  102.     BEGIN
  103.     ix := index(firstname,'.'); { search for an extension }
  104.     jx := index(firstname,' '); { search for the first space }
  105.     IF (ix=0) then{ no extension was specified }
  106.       setlength(firstname,jx-1)
  107.     ELSE
  108.       setlength(firstname,ix-1);
  109.  
  110.     { fname := CONCAT( firstname, '.LST' ); }
  111.     setlength(fname,0);
  112.     append(fname, firstname);
  113.     append(fname, '.LST');
  114.     PAD(fname, fid_len);
  115.     REWRITE(fname, FOUT);
  116.     end;
  117. END{ of ConnectFiles };
  118.  
  119. PROCEDURE Initialize;
  120. VAR    IX: 1..25;
  121.     ch: char;
  122. BEGIN
  123.   FOR IX:=1 TO 25 DO WRITELN;
  124.   linecount := 0;
  125.   charcount := 0;
  126.   blankcount := 0;
  127.   other := 0;
  128.   wordcount := 0;
  129.   tab := CHR(9);
  130.   ConnectFiles;
  131.   IF NOT fatal_error THEN
  132.     BEGIN
  133.       WRITE('Output to Console?');
  134.       READLN(ch);
  135.       con_wanted := ( (ch='Y') or (ch='y') );
  136.     END;
  137.   WRITELN;
  138. END;
  139.  
  140. (*$C+*)
  141. BEGIN{ main program LINENOS }
  142.   Initialize;
  143.   WHILE (NOT EOF(FIN)) AND (NOT fatal_error) DO
  144.     BEGIN
  145.       linecount := succ(linecount);
  146.       WRITE(FOUT, linecount:(left_margin),': ');
  147.       IF con_wanted THEN
  148.     WRITE( linecount:(left_margin),': ');
  149.       WHILE NOT EOLN(FIN) Do
  150.         BEGIN
  151.           GetC(ch);
  152.           Classify(ch);
  153.           WRITE(FOUT, ch);
  154.           IF con_wanted THEN WRITE(ch);
  155.         END{ while NOT eoln };
  156.       READLN(FIN); {+++ ignore the line boundary +++}
  157.       WRITELN(FOUT);
  158.       IF con_wanted THEN WRITELN;
  159.     END;
  160.   Summary;
  161. END{ of LINENOS }.
  162.