{--------------------------------------------------------------}
{                          WORDSTAT                            }
{                                                              }
{     Word Counter & Word Length Tabulator for Textfiles       }
{                                                              }
{                              by Jeff Duntemann               }
{                              Turbo Pascal V2.0               }
{                              Last update 10/26/84            }
{                                                              }
{                 (c) 1984 by Jeff Duntemann                   }
{                     ALL RIGHTS RESERVED                      }
{--------------------------------------------------------------}


PROGRAM WORDSTAT;


CONST PRINT_WIDTH = 68;


TYPE  ARRAY_40    = ARRAY[0..40] OF INTEGER;
      STRING80    = STRING[80];

VAR   I,J,K       : INTEGER;
      SCALE       : REAL;
      CH          : CHAR;
      OPENED      : BOOLEAN;
      TESTFILE    : TEXT;
      FNAME       : STRING80;
      COUNTERS    : ARRAY_40;
      LINE        : STRING80;
      A_WORD      : STRING80;
      WORD_LENGTH : INTEGER;
      LINECOUNT   : INTEGER;
     {TAIL        : STRING80 ABSOLUTE $80;}         { For CP/M-80 }
      TAIL        : STRING80 ABSOLUTE CSEG : $80;   { For PC/MS DOS }


PROCEDURE KILL_WHITE(VAR A_STRING : STRING80);

VAR WHITESPACE : SET OF CHAR;

BEGIN
  WHITESPACE := [CHR(8),CHR(9),CHR(10),CHR(12),CHR(13),' '];
  REPEAT
    IF LENGTH(A_STRING) > 0 THEN
      IF A_STRING[1] IN WHITESPACE THEN DELETE(A_STRING,1,1);
  UNTIL (NOT (A_STRING[1] IN WHITESPACE)) OR (LENGTH(A_STRING)<=0)
END;



PROCEDURE OPENER(    FILENAME : STRING80;
                 VAR TFILE    : TEXT;
                 VAR OPENFLAG : BOOLEAN);

VAR I : INTEGER;

BEGIN
  ASSIGN(TFILE,FILENAME);       { Associate logical to physical }
  RESET(TFILE);      { Open file for read    }
  I := IORESULT;                { I <> 0 = File Not Found  }
  IF I = 0 THEN OPENFLAG := TRUE ELSE OPENFLAG := FALSE;
END;  { OPENER }



FUNCTION SCALER(COUNTERS : ARRAY_40) : REAL;

VAR I,MAXCOUNT : INTEGER;

BEGIN
  MAXCOUNT := 0;           { Set initial count to 0 }
  FOR I := 1 TO 40 DO
    IF COUNTERS[I] > MAXCOUNT THEN MAXCOUNT := COUNTERS[I];
  IF MAXCOUNT > PRINT_WIDTH THEN SCALER := PRINT_WIDTH / MAXCOUNT
    ELSE SCALER := 1.0;    { Scale=1 if max < printer width}
END;  { SCALER }



PROCEDURE GRAPHER(COUNTERS : ARRAY_40; SCALE : REAL);

VAR I,J : INTEGER;

BEGIN
  writeln(scale);
  FOR I := 1 TO 40 DO
    BEGIN
      WRITE(LST,'[',I:3,']: ');                { Show count }
      FOR J:=1 TO ROUND(COUNTERS[I] * SCALE) DO WRITE(LST,'*');
      WRITELN(LST,'')                          { Add (CR) at end of *'s}
    END
END;


BEGIN   { CHARSTAT MAIN }

  FNAME := TAIL;                 { We must pick up command tail first, }
  KILL_WHITE(FNAME);             { before opening any files! }
  FOR I:=0 TO 40 DO COUNTERS[I]:=0;          { Init counters }
  LINECOUNT := 0;

  OPENER(FNAME,TESTFILE,OPENED);  { Attempt to open input file  }
  IF NOT OPENED THEN              { If we can't open it...      }
    BEGIN
      WRITELN('>>>Input file ',FNAME,' is missing or damaged.');
      WRITELN('   Please check this file''s status and try again.');
    END
  ELSE                            { If you've got a file, run with it! }
    BEGIN
      WHILE NOT EOF(TESTFILE) DO              { While there's stuff in the file }
        BEGIN
          READLN(TESTFILE,LINE);              { Read a line }
          LINECOUNT := LINECOUNT + 1;         { Count the line }
          WHILE LENGTH(LINE) > 0 DO           { While there are words in the line }
            BEGIN
              KILL_WHITE(LINE);               { Remove any leading whitespace }
              IF POS(' ',LINE) > 0 THEN
                A_WORD := COPY(LINE,1,POS(' ',LINE)) ELSE A_WORD := LINE;
              COUNTERS[0] := COUNTERS[0] + 1;    { Count the word }
              WORD_LENGTH := LENGTH(A_WORD);
              IF WORD_LENGTH > 40 THEN WORD_LENGTH := 40;
              J := COUNTERS[WORD_LENGTH];     { Get counter for that length }
              J := J + 1;                     { Increment it...     }
              COUNTERS[WORD_LENGTH] := J;     { ...and put it back. }
              DELETE(LINE,1,LENGTH(A_WORD));  { Remove the word from the line }
            END
        END;

      CLOSE(TESTFILE);                { Close the input file }

      SCALE := SCALER(COUNTERS);      { Scale the counters }
      WRITELN(LST,
      '>>Text file ',FNAME,
      ' has ',COUNTERS[0],
      ' words in ',LINECOUNT,' lines.');
      WRITELN(LST,
      '  Word size histogram follows:');
      GRAPHER(COUNTERS,SCALE);        { Display scaled histograms  }
      WRITELN(LST,CHR(12));           { Send a formfeed to printer }
    END
END.