home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol142 / fogindex.pli < prev    next >
Encoding:
Text File  |  1984-04-29  |  2.8 KB  |  110 lines
  1. /*
  2.     fogindex.pli - written by Les Bell, 11/04/82
  3.  
  4.     Calculates the 'Fog Index' developed by the Gunning-Mueller
  5.     Clear Writing Institute. The fog index is roughly equal to
  6.     the number of years of (US) schooling required to read a
  7.     piece of writing. The fog index is the average sentence length
  8.     plus the percentage of words having three or more syllables,
  9.     all multiplied by 0.4.
  10.  
  11.     Compile using PLI.COM, then assemble FOGASM.ASM using
  12.     RMAC and link with LINK FOGINDEX,FOGASM.
  13.  
  14.     To run, type FOGINDEX <filename>.
  15. */
  16.  
  17. fogindex:
  18.     procedure options(main);
  19.  
  20.     dcl sourcefile file,
  21.         buff char (254) varying,
  22.         bufptr binary (15);
  23.  
  24.     dcl (c, v, s, lw, ns, nl, nw, nc) fixed binary static init (0);
  25.     dcl fi fixed decimal (4,2);
  26.     dcl inword bit (1);
  27.     dcl eof bit (1) static init ('0'b);
  28.     dcl vtrue bit (1);
  29.     dcl word char(4) static initial (' ');
  30.     dcl thischar char;
  31.     dcl i fixed binary (4);
  32.     dcl strip entry (char);
  33.     dcl vowel entry (char) returns (bit (1));
  34.     dcl sl entry (char (4));
  35.  
  36. %replace
  37.     YES    by '1'b,
  38.     NO    by '0'b;
  39.  
  40. put skip list ('Fog Index Calculator, Rev 1.2');
  41.  
  42. on endfile (sourcefile) eof = '1'b;
  43.  
  44. on undefinedfile (sourcefile) begin;
  45.     put skip list ('Usage : fogindex <filename>');
  46.     stop;
  47.     end;
  48.  
  49. on zerodivide (1) begin;
  50.     put skip list ('No sentences or words in file.');
  51.     put skip list ('Can''t calculate fog index');
  52.     stop;
  53.     end;
  54.  
  55. open file (sourcefile) stream title ('$1.$1')
  56.     env(b(1024));
  57.  
  58. inword = NO;
  59. do while (~eof);
  60.     get file (sourcefile) edit (buff) (a);
  61.     nl = nl + 1;
  62.     do bufptr = 1 repeat (bufptr + 1) while (bufptr ~> length (buff));
  63.         thischar = substr(buff,bufptr,1);
  64.         call strip(thischar);
  65.         call sl(word);
  66.         substr(word,4,1) = thischar;
  67.         nc = nc + 1;
  68.         if thischar = '.' then ns = ns + 1;
  69.         if thischar = ' ' | thischar = '^M' |
  70.             thischar = '^I' then call wordend;
  71.         else if inword = NO then do    /* beginning of word */
  72.             inword = YES;
  73.             nw = nw + 1;
  74.         end;
  75.         if vowel (thischar) then do;
  76.             s = s + 1;    /* count syllables */
  77.             v = v + 1;    /* count adjacent vowels */
  78.         end;
  79.         else v = 0;
  80.         if v = 2 then do;    /* two vowels adjacent */
  81.             s = s - 1;    /* count as one syllable */
  82.             v = 0;        /* reset vowel counter */
  83.         end;
  84.             /* detect silent 'E' or 'ED' */
  85.         if index (word, 'ED') > 0 & ~(index (word, 'DED') > 0 |
  86.             index (word, 'TED') > 0) then s = s - 1;
  87.         if (index (word, 'E') > 0 & (index (word, 'LE')) = 0)
  88.             then s = s -1;
  89.     end;
  90. end;
  91.  
  92. wordend: procedure;
  93.                     /* count long words */
  94.     if (inword = YES) & (s > 2) then lw = lw + 1;
  95.     inword = NO;            /* exit word */
  96.     s = 0;                /* reset syllable counter */
  97. end wordend;
  98.  
  99.     put skip list ('Number of sentences  = ',ns);
  100.     put skip list ('Number of lines      = ',nl);
  101.     put skip list ('Number of words      = ',nw);
  102.     put skip list ('Number of characters = ',nc);
  103.  
  104.     fi = (decimal(nw,7,2) / decimal(ns,7,2) + 100 *
  105.         decimal(lw,7,2) / decimal(nw,7,2)) * 4 / 10;
  106.  
  107.     put skip (2) list ('Fog Index = ',fi);
  108.  
  109. end fogindex;
  110.