home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CMPLTPAS.ZIP / WORDSTAT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-07-15  |  5.6 KB  |  165 lines
  1.  
  2. {--------------------------------------------------------------}
  3. {                           WordStat                           }
  4. {                                                              }
  5. {     Word Counter & Word Length Tabulator for TextFiles       }
  6. {                                                              }
  7. {                              by Jeff Duntemann               }
  8. {                              and Hugh Kenner                 }
  9. {                              Turbo Pascal V5.0               }
  10. {                              Last update 7/14/88             }
  11. {                                                              }
  12. {     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
  13. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  14. {--------------------------------------------------------------}
  15.  
  16. PROGRAM WordStat;
  17.  
  18. USES Printer;
  19.  
  20. CONST
  21.   PrintWidth  = 68;
  22.   Tab         = #9;
  23.  
  24.  
  25. TYPE
  26.   Array40     = ARRAY[0..40] OF Integer;
  27.   String80    = String[80];
  28.  
  29. VAR
  30.   I,J         : Integer;
  31.   Scale       : Real;
  32.   Ch          : Char;
  33.   Opened      : Boolean;
  34.   TestFile    : Text;
  35.   FName       : String80;
  36.   Counters    : Array40;
  37.   Line        : String80;
  38.   AWord       : String80;
  39.   WordLength  : Integer;
  40.   LineCount   : Integer;
  41.   WhiteSpace  : SET OF Char;
  42.   GoodChars   : SET OF Char;
  43.  
  44.  
  45. PROCEDURE KillJunk(VAR AString : String80);
  46.  
  47. BEGIN
  48.   WhiteSpace := [#8,#9,#10,#12,#13,#32];
  49.   GoodChars  := ['A'..'Z','a'..'z','0'..'9'];
  50.   REPEAT        { Clean up leading end of word }
  51.     IF Length(AString) > 0 THEN
  52.       IF (AString[1] IN WhiteSpace) OR (NOT(AString[1] IN GoodChars))
  53.         THEN Delete(AString,1,1)
  54.   UNTIL ((NOT (AString[1] IN WhiteSpace)) AND (AString[1] IN GoodChars))
  55.     OR (Length(AString) <= 0);
  56.   REPEAT        { Clean up trailing end of word }
  57.     IF Length(AString) > 0 THEN
  58.       IF (AString[Length(AString)] IN WhiteSpace)
  59.         OR (NOT(AString[Length(AString)] IN GoodChars))
  60.       THEN Delete(AString,Length(AString),1)
  61.   UNTIL ((NOT(AString[Length(AString)] IN WhiteSpace)
  62.     AND (AString[Length(AString)] IN GoodChars))
  63.     OR  (Length(AString) <= 0))
  64. END;  { KillJunk }
  65.  
  66.  
  67.  
  68. PROCEDURE Opener(    FileName : String80;
  69.                  VAR TFile    : Text;
  70.                  VAR OpenFlag : Boolean);
  71.  
  72. VAR
  73.   I : Integer;
  74.  
  75. BEGIN
  76.   Assign(TFile,FileName);       { Associate logical to physical }
  77.   {$I-} Reset(TFile); {$I+}     { Open file for read    }
  78.   I := IOResult;                { I <> 0 = File Not Found  }
  79.   IF I = 0 THEN OpenFlag := True ELSE OpenFlag := False;
  80. END;  { Opener }
  81.  
  82.  
  83.  
  84. FUNCTION Scaler(Counters : Array40) : Real;
  85.  
  86. VAR
  87.   I,MaxCount : Integer;
  88.  
  89. BEGIN
  90.   MaxCount := 0;           { Set initial count to 0 }
  91.   FOR I := 1 TO 40 DO
  92.     IF Counters[I] > MaxCount THEN MaxCount := Counters[I];
  93.   IF MaxCount > PrintWidth THEN Scaler := PrintWidth / MaxCount
  94.     ELSE Scaler := 1.0;    { Scale=1 if max < printer width}
  95. END;  { Scaler }
  96.  
  97.  
  98.  
  99. PROCEDURE Grapher(Counters : Array40; Scale : Real);
  100.  
  101. VAR
  102.   I,J : Integer;
  103.  
  104. BEGIN
  105.   FOR I := 1 TO 40 DO
  106.     BEGIN
  107.       Write(Lst,'[',I:3,']: ');      { Show count }
  108.       FOR J:=1 TO Round(Counters[I] * Scale) DO Write(Lst,'*');
  109.       Writeln(Lst,'')                { Add (CR) at end of *'s}
  110.     END
  111. END;
  112.  
  113.  
  114. BEGIN   { WordStat Main }
  115.  
  116.   FName := ParamStr(1);           { We must pick up command tail first, }
  117.   KillJunk(FName);                {   before opening any files! }
  118.   FOR I:=0 TO 40 DO Counters[I]:=0;          { Init Counters }
  119.   LineCount := 0;
  120.  
  121.   Opener(FName,TestFile,Opened);  { Attempt to open input file  }
  122.   IF NOT Opened THEN              { If we can't open it...      }
  123.     BEGIN
  124.       Writeln('>>>Input file ',FName,' is missing or damaged.');
  125.       Writeln('   Please Check this file''s status and try again.');
  126.     END
  127.   ELSE                            { If you've got a file, run with it! }
  128.     BEGIN
  129.       WHILE NOT EOF(TestFile) DO  { While there's stuff in the file }
  130.         BEGIN
  131.           Readln(TestFile,Line);        { Read a Line }
  132.           LineCount := LineCount + 1;   { Count the Line }
  133.           Write('.');                   { Display a progress indicator }
  134.           FOR I := 1 TO Length(Line) DO
  135.             IF Line[I] = Tab THEN Line[I] := ' ';
  136.           WHILE Length(Line) > 0 DO     { While there are words in the Line }
  137.             BEGIN
  138.               KillJunk(Line);           { Remove any non-text characters }
  139.               IF POS(' ',Line) > 0 THEN
  140.                 AWord := Copy(Line,1,POS(' ',Line)) ELSE AWord := Line;
  141.               KillJunk(AWord);          { Clean up the individual word }
  142.               Counters[0] := Succ(Counters[0]);    { Count the word }
  143.               WordLength := Length(AWord);
  144.               IF WordLength > 40 THEN WordLength := 40;
  145.               J := Counters[WordLength]; { Get counter for that Length }
  146.               J := Succ(J);              { Increment it...     }
  147.               Counters[WordLength] := J; { ...and put it back. }
  148.               Delete(Line,1,Length(AWord));  { Remove the word from the Line }
  149.             END
  150.         END;
  151.       Writeln;
  152.       Close(TestFile);                { Close the input file }
  153.       { The count itself is done.  Now to display it: }
  154.       Scale := Scaler(Counters);      { Scale the Counters }
  155.       Writeln(Lst,
  156.       '>>Text file ',FName,
  157.       ' has ',Counters[0],
  158.       ' words in ',LineCount,' Lines.');
  159.       Writeln(Lst,
  160.       '  Word size histogram follows:');
  161.       Grapher(Counters,Scale);        { Display Scaled histograms  }
  162.       Writeln(Lst,Chr(12));           { Send a formfeed to printer }
  163.     END
  164. END.
  165.