home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol134 / cleanprt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  4.3 KB  |  167 lines
  1. {$C+ generate CTRL-C check in code                    }
  2. {$E+ generate code for line numbers in error messages }
  3. {$M+ generate checks for multiply/divde               }
  4. {$S+ enable stack overflow checking code              }
  5. {$R+ enable range/bound checking                      }
  6. {$U+ enable parameter bound checking                  }
  7.  
  8. PROGRAM CLEANPRT;
  9.  
  10. CONST
  11.  
  12. {$ICONSTS.PAS }
  13.  
  14. LF          = 10;
  15.  
  16. NAMELEN     = 8;
  17. FILENAMELEN = 14;
  18. EXTIN       = '.LET';
  19. EXTOUT      = '.CLN';
  20. MAXLINE     = 255;
  21.  
  22.  
  23. TYPE
  24.  
  25. {$ITYPES.PAS }
  26.  
  27. NAMETYPE = STRING NAMELEN;
  28. FNTYPE   = STRING FILENAMELEN;
  29.  
  30.  
  31.  
  32.  
  33. VAR
  34.  
  35. INFILENAME, OUTFILENAME: FNTYPE;
  36. INFILE, OUTFILE: TEXT;
  37.  
  38. BADCHRCOUNT,
  39. LINES: INTEGER;
  40.  
  41.  
  42.  
  43. {$IPROCS.PAS }
  44. {$IGETFILES.PAS }
  45.  
  46.  
  47.  
  48.  
  49.  
  50.  
  51. PROCEDURE CLEANCOPY;
  52. VAR  C,I,J: byte;
  53.      CH : CHAR;
  54.      LINE: string maxline;
  55.  
  56.  
  57. procedure writeline;
  58. begin  {* writeline *}
  59.      lines := succ(lines);
  60.      setlength(line,i);
  61.      writeln(outfile,line);
  62.      i := 0;
  63.      setlength(line,maxline);
  64. end;  {* writeline *}
  65.  
  66.  
  67. BEGIN  {* CLEANCOPY *}
  68.      I := 0;
  69.      setlength(line,maxline);
  70.      REPEAT BEGIN
  71.           IF eoln(infile) then begin
  72.                readln(infile,ch);
  73.                writeline;
  74.           end
  75.           else begin
  76.                i := succ(i);
  77.                read(infile,line[i]);
  78.                c := ord(line[i]);
  79.                IF C > 127 THEN BEGIN    { Turn off high bit if left on }
  80.                     c := c - 128;
  81.                     line[i] := chr( c );
  82.                end;
  83.                if (C<32) or (C=127) then begin
  84.                     case  C  of
  85.  
  86.                          TAB: begin  { assume tab every eighth column }
  87.                               if  (i mod 8) = 0  then begin
  88.                                    for j := i to (i+7) do begin
  89.                                         Line[j] := blank;
  90.                                    end;
  91.                                    i := i + 8;
  92.                               end
  93.                               else begin
  94.                                    while (i mod 8) <> 0  do begin
  95.                                         Line[i] := blank;
  96.                                         i := succ(i);
  97.                                    end;
  98.                               end;
  99.                               Line[i] := blank;
  100.                          end;
  101.  
  102.                          LF:  begin  { discard if at beginning of line }
  103.                                      { else insert CR.                 }
  104.                               i := pred(i);
  105.                               if  i>1 then begin  { assume end of record }
  106.                                    i := pred(i);
  107.                                    writeline;
  108.                               end;
  109.                          end;
  110.                          
  111.                          CR:  begin  { assume eoln, LF case above will catch }
  112.                                      { following line-feed                   }
  113.                               i := pred(i);
  114.                               writeline;
  115.                          end;
  116.                          
  117.                          FF:  begin  { pass this through - recognize as eoln }
  118.                               writeline;
  119.                          end;
  120.  
  121.                          ELSE:begin
  122.                               Line[i] := blank;
  123.                               BADCHRCOUNT := SUCC(BADCHRCOUNT);
  124.                               writeln('Unusual Character: CHR(',C:3,'), line:',
  125.                                       LINES:0);
  126.                          end;
  127.                     end;  { case C of }
  128.                end;
  129.           end;
  130.      END  UNTIL EOF(INFILE);
  131. END;  {* CLEANCOPY *}
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138. BEGIN {* CLEANPRT *}
  139.  
  140. { OPEN FILES UP }
  141.  
  142.      GETFILENAMES(EXTIN,EXTOUT);
  143.      WRITELN('READING FROM ',INFILENAME);
  144.      RESET(INFILENAME,INFILE);
  145.      IF EOF(INFILE) THEN BEGIN
  146.           WRITELN(INFILENAME,' IS EMPTY.');
  147.      END
  148.      ELSE BEGIN
  149.           WRITELN('WRITING TO   ',OUTFILENAME);
  150.           RESET(INFILENAME,INFILE);
  151.           REWRITE(OUTFILENAME,OUTFILE);
  152.  
  153. { COPY INPUT TO OUTPUT WHILE CLEANING UP BAD CHARACTERS }
  154.  
  155.           LINES := 0;
  156.           BADCHRCOUNT := 0;
  157.       CLEANCOPY;
  158.  
  159. { TELL 'EM THAT YOU ARE DONE }
  160.      
  161.           WRITELN('DONE.  ');
  162.           WRITELN('       ',LINES:0,' RECORDS CLEANED.');
  163.           WRITELN('       ',BADCHRCOUNT:0,' UNUSUAL CHARACTERS FOUND.');
  164.      END;
  165.  
  166. END.  {* CLEANPRT *}
  167.