home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TP-UTIL.ARK / WORDSTAT.PAS < prev    next >
Pascal/Delphi Source File  |  1986-01-06  |  5KB  |  146 lines
  1.  
  2. {--------------------------------------------------------------}
  3. {                          WORDSTAT                            }
  4. {                                                              }
  5. {     Word Counter & Word Length Tabulator for Textfiles       }
  6. {                                                              }
  7. {                              by Jeff Duntemann               }
  8. {                              Turbo Pascal V2.0               }
  9. {                              Last update 10/26/84            }
  10. {                                                              }
  11. {                 (c) 1984 by Jeff Duntemann                   }
  12. {                     ALL RIGHTS RESERVED                      }
  13. {--------------------------------------------------------------}
  14.  
  15.  
  16. PROGRAM WORDSTAT;
  17.  
  18.  
  19. CONST PRINT_WIDTH = 68;
  20.  
  21.  
  22. TYPE  ARRAY_40    = ARRAY[0..40] OF INTEGER;
  23.       STRING80    = STRING[80];
  24.  
  25. VAR   I,J,K       : INTEGER;
  26.       SCALE       : REAL;
  27.       CH          : CHAR;
  28.       OPENED      : BOOLEAN;
  29.       TESTFILE    : TEXT;
  30.       FNAME       : STRING80;
  31.       COUNTERS    : ARRAY_40;
  32.       LINE        : STRING80;
  33.       A_WORD      : STRING80;
  34.       WORD_LENGTH : INTEGER;
  35.       LINECOUNT   : INTEGER;
  36.      {TAIL        : STRING80 ABSOLUTE $80;}         { For CP/M-80 }
  37.       TAIL        : STRING80 ABSOLUTE CSEG : $80;   { For PC/MS DOS }
  38.  
  39.  
  40. PROCEDURE KILL_WHITE(VAR A_STRING : STRING80);
  41.  
  42. VAR WHITESPACE : SET OF CHAR;
  43.  
  44. BEGIN
  45.   WHITESPACE := [CHR(8),CHR(9),CHR(10),CHR(12),CHR(13),' '];
  46.   REPEAT
  47.     IF LENGTH(A_STRING) > 0 THEN
  48.       IF A_STRING[1] IN WHITESPACE THEN DELETE(A_STRING,1,1);
  49.   UNTIL (NOT (A_STRING[1] IN WHITESPACE)) OR (LENGTH(A_STRING)<=0)
  50. END;
  51.  
  52.  
  53.  
  54. PROCEDURE OPENER(    FILENAME : STRING80;
  55.                  VAR TFILE    : TEXT;
  56.                  VAR OPENFLAG : BOOLEAN);
  57.  
  58. VAR I : INTEGER;
  59.  
  60. BEGIN
  61.   ASSIGN(TFILE,FILENAME);       { Associate logical to physical }
  62.   RESET(TFILE);      { Open file for read    }
  63.   I := IORESULT;                { I <> 0 = File Not Found  }
  64.   IF I = 0 THEN OPENFLAG := TRUE ELSE OPENFLAG := FALSE;
  65. END;  { OPENER }
  66.  
  67.  
  68.  
  69. FUNCTION SCALER(COUNTERS : ARRAY_40) : REAL;
  70.  
  71. VAR I,MAXCOUNT : INTEGER;
  72.  
  73. BEGIN
  74.   MAXCOUNT := 0;           { Set initial count to 0 }
  75.   FOR I := 1 TO 40 DO
  76.     IF COUNTERS[I] > MAXCOUNT THEN MAXCOUNT := COUNTERS[I];
  77.   IF MAXCOUNT > PRINT_WIDTH THEN SCALER := PRINT_WIDTH / MAXCOUNT
  78.     ELSE SCALER := 1.0;    { Scale=1 if max < printer width}
  79. END;  { SCALER }
  80.  
  81.  
  82.  
  83. PROCEDURE GRAPHER(COUNTERS : ARRAY_40; SCALE : REAL);
  84.  
  85. VAR I,J : INTEGER;
  86.  
  87. BEGIN
  88.   writeln(scale);
  89.   FOR I := 1 TO 40 DO
  90.     BEGIN
  91.       WRITE(LST,'[',I:3,']: ');                { Show count }
  92.       FOR J:=1 TO ROUND(COUNTERS[I] * SCALE) DO WRITE(LST,'*');
  93.       WRITELN(LST,'')                          { Add (CR) at end of *'s}
  94.     END
  95. END;
  96.  
  97.  
  98. BEGIN   { CHARSTAT MAIN }
  99.  
  100.   FNAME := TAIL;                 { We must pick up command tail first, }
  101.   KILL_WHITE(FNAME);             { before opening any files! }
  102.   FOR I:=0 TO 40 DO COUNTERS[I]:=0;          { Init counters }
  103.   LINECOUNT := 0;
  104.  
  105.   OPENER(FNAME,TESTFILE,OPENED);  { Attempt to open input file  }
  106.   IF NOT OPENED THEN              { If we can't open it...      }
  107.     BEGIN
  108.       WRITELN('>>>Input file ',FNAME,' is missing or damaged.');
  109.       WRITELN('   Please check this file''s status and try again.');
  110.     END
  111.   ELSE                            { If you've got a file, run with it! }
  112.     BEGIN
  113.       WHILE NOT EOF(TESTFILE) DO              { While there's stuff in the file }
  114.         BEGIN
  115.           READLN(TESTFILE,LINE);              { Read a line }
  116.           LINECOUNT := LINECOUNT + 1;         { Count the line }
  117.           WHILE LENGTH(LINE) > 0 DO           { While there are words in the line }
  118.             BEGIN
  119.               KILL_WHITE(LINE);               { Remove any leading whitespace }
  120.               IF POS(' ',LINE) > 0 THEN
  121.                 A_WORD := COPY(LINE,1,POS(' ',LINE)) ELSE A_WORD := LINE;
  122.               COUNTERS[0] := COUNTERS[0] + 1;    { Count the word }
  123.               WORD_LENGTH := LENGTH(A_WORD);
  124.               IF WORD_LENGTH > 40 THEN WORD_LENGTH := 40;
  125.               J := COUNTERS[WORD_LENGTH];     { Get counter for that length }
  126.               J := J + 1;                     { Increment it...     }
  127.               COUNTERS[WORD_LENGTH] := J;     { ...and put it back. }
  128.               DELETE(LINE,1,LENGTH(A_WORD));  { Remove the word from the line }
  129.             END
  130.         END;
  131.  
  132.       CLOSE(TESTFILE);                { Close the input file }
  133.  
  134.       SCALE := SCALER(COUNTERS);      { Scale the counters }
  135.       WRITELN(LST,
  136.       '>>Text file ',FNAME,
  137.       ' has ',COUNTERS[0],
  138.       ' words in ',LINECOUNT,' lines.');
  139.       WRITELN(LST,
  140.       '  Word size histogram follows:');
  141.       GRAPHER(COUNTERS,SCALE);        { Display scaled histograms  }
  142.       WRITELN(LST,CHR(12));           { Send a formfeed to printer }
  143.     END
  144. END.
  145. (POS('PRINT',PARMS[2]) = 1) OR (POS('P',PARMS[2]) = 1) THEN
  146.             ASSIGN(DEVICE,'LST:') ELSE ASS