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 / SIMTEL / CPMUG / CPMUG080.ARK / GRADER.STB < prev    next >
Text File  |  1984-04-29  |  12KB  |  283 lines
  1.  
  2.    10   Gosub Screen'erase
  3.    20   @"Text Analyzing Program"
  4.    30   @"By David E. Trachtenbarg"
  5.    40   @"Version 04/14/81"
  6.    50   Integer Sector
  7.    60   Sector=128
  8.    70   Dim Text$(Sector*2),Eof$(1),String$(10),Text'file$(13)
  9.    80   Dim Uppercase$(25),Lowercase$(25),Numbers$(10),Letters$(63)
  10.    90   Dim Vowels$(11),Consonants$(39),End'of'word$(19)
  11.   100   Integer I,J,K,Record,Words,Sentences,Finish
  12.   110   Integer Startword,Endword,Start'sentence,End'sentence
  13.   120   Integer Sentence'words,Long'words,Vowel1
  14.   140   Long Average'words,Average'syllables,Reading'ease,Fog'index
  15.   150   Uppercase$="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  16.   160   Lowercase$="abcdefghijklmnopqrstuvwxyz"
  17.   170   Vowels$="aAeEiIoOuUyY"
  18.   180   Consonants$="bBcCdDeEfFgGhHjJkKlLmMnNpPqQrRsStTvVwWxXzZ"
  19.   190   End'of'word$=" ?!;:()+/=&[]{}#"""+Chr$(13)
  20.   200   Numbers$="0123456789"
  21.   210   Letters$=Uppercase$+Lowercase$+Numbers$
  22.   220   Eof$=Chr$(26)+Chr$(27)
  23.   230   Rem Set 0,-1 prevents auto CR at end of 80 char string on console
  24.   240   Set 0,-1
  25.   250   Gosub Enter'text'file
  26.   260   Record=-1
  27.   270   Words=0
  28.   280   Sentences=0
  29.   290   Syllables=0
  30.   300   Long'words=0
  31.   310   Open\1\Text'file$
  32.   320   On Esc Goto Display'results
  33.   340   Gosub Get'file
  34.   350   Gosub Count
  35.   380 *Display'results
  36.   390   Close
  37.   400   @ : @ : @"File: ";Text'file$ : @
  38.   410   @"Words = ";Words
  39.   420   @"Sentences = ";Sentences
  40.   430   @"Syllables = ";Syllables
  41.   440   @"Words with 3 or more syllables = ";Long'words
  42.   450   Average'words=1.0*(Words/Sentences)
  43.   460   @ : @"Average number of words per sentence = ";
  44.   470   @ Using"###.#",Average'words
  45.   480   Average'syllables=100.0*(Syllables/Words)
  46.   490   @"Syllables per 100 words = ";
  47.   500   @ Using"####",Average'syllables
  48.   510   Reading'ease=206.835-((Average'words*1.015)+(Average'syllables*0.846))
  49.   520   @ : @"Reading ease = ";
  50.   530   @ Using"####.#",Reading'ease;
  51.   540   If Reading'ease>=90 Then @"  Comics - 4th grade  93";
  52.   550   If Reading'ease>=80 And Reading'ease<90 Then @"  Pulp fiction - 5th grade  91";
  53.   560   If Reading'ease>=70 And Reading'ease<80 Then @"  Slick fiction - 6th grade  88";
  54.   570   If Reading'ease>=60 And Reading'ease<70 Then @"  Digests - 8th grade  83";
  55.   580   If Reading'ease>=50 And Reading'ease<60 Then @"  Quality - High School  54";
  56.   590   If Reading'ease>=30 And Reading'ease<50 Then @"  Academic - College  33";
  57.   600   If Reading'ease<30 Then @"  Scientific - Graduate School  5";
  58.   610   @"% of all U.S. adults."
  59.   620   Fog'index=0.4*(Words/Sentences+100.0*Long'words/Words)
  60.   630   @ : @"Grade level by Fog Index = ";
  61.   640   @ Using"###.#",Fog'index
  62.   650   @ : @
  63.   660   End
  64.   670 *Screen'erase
  65.   680   Out 1,126 : Out 1,28 : Return
  66.   690 *Enter'text'file
  67.   700   Rem Enter the name of a text file
  68.   710     Repeat
  69.   720     Set 3,0
  70.   730     @ : Input"Enter the name of the text file. ",Text'file$
  71.   740     On Error Goto 770
  72.   750     Open\1\Text'file$
  73.   760     Close\1\
  74.   770     If Sys(3)>0 Then  Do
  75.   780       @ : @"Error ";Sys(3);" has occured."
  76.   790       If Sys(3)=128 Or Sys(3)=134 Then @"File does not exist on disk."
  77.   800       If Sys(3)=129 Then @"Please enter a filename."
  78.   810       If Sys(3)=131 Then Close\1\ : @"File not ready.  Please try again."
  79.   820       Enddo
  80.   830     Until Sys(3)=0
  81.   840   On Error Stop
  82.   850   Return
  83.   860 *Get'file
  84.   870   Rem Read in the text file a sector at a time
  85.   880   Rem Store the text file in Text$ variable
  86.   910   Text$(0,Sector-1)=Text$(Sector,Sector*2-1)
  87.   920   Record=Record+1
  88.   930   Get\1,Record\Text$(Sector,Sector*2-1)
  89.   940   Finish=Pos(Text$,Eof$(0,0),0)
  90.   950   If Finish=-1 Then Finish=Sector*2
  91.   960   I=Sector
  92.   970   Startword=Startword-Sector
  93.   980   Start'sentence=Start'sentence-Sector
  94.   990   Return
  95.  1000 *Count
  96.  1010   Rem Analyzes text
  97.  1030   Rem Repeats until an end of file condition is reached
  98.  1040     Repeat
  99.  1050     Gosub Wordstart
  100.  1060     Start'sentence=I
  101.  1070     Sentence'words=0
  102.  1080     End'sentence=0
  103.  1090     Rem Repeats until the end of a sentence
  104.  1100       Repeat
  105.  1110       Gosub Wordstart
  106.  1140       Startword=I
  107.  1150       Endword=0
  108.  1160       Rem Loops until the end of a word is found
  109.  1170         While Endword=0 And I<Finish
  110.  1180         Rem Check to see of alphanumerics are present
  111.  1190         If Pos(Letters$,Text$(I,I),0)=-1 Then  Do
  112.  1200           If Pos(End'of'word$,Text$(I,I),0)>-1 Then Endword=I-1
  113.  1210           Rem Numbers such as 2.345 are counted as one word
  114.  1220           If Text$(I,I)="." Then  Do
  115.  1230             If Pos(Numbers$,Text$(I+1,I+1),0)=-1 Then Endword=I-1
  116.  1240             Enddo
  117.  1250           Rem Numbers such as 2,123 are counted as one word
  118.  1260           If Text$(I,I)="," Then  Do
  119.  1270             If Pos(Numbers$,Text$(I+1,I+1),0)=-1 Then Endword=I-1
  120.  1280             Enddo
  121.  1290           Rem Hyphenated words are counted as two words
  122.  1300           Rem A hyphen at the end of a line is assumed to broken word
  123.  1310           If Text$(I,I)="-" Then  Do
  124.  1320             If Text$(I+1,I+1)=Chr$(13) Then  Do
  125.  1330               I=I+2
  126.  1340               If I>=Sector Then Gosub Get'file
  127.  1350               Else
  128.  1360               Endword=I-1
  129.  1370               Enddo
  130.  1380             Enddo
  131.  1390           Enddo
  132.  1400         If Endword=0 Then I=I+1
  133.  1410         If I=Sector*2 Then Gosub Get'file
  134.  1420         Endwhile
  135.  1430       Words=Words+1
  136.  1440       Sentence'words=Sentence'words+1
  137.  1450       Gosub Count'syllables
  138.  1460       Rem Check for the end of a sentence
  139.  1470         While Pos(Letters$,Text$(I,I),0)=-1 And Text$(I,I)<>"@" And I<=Finish
  140.  1480         If Text$(I,I)="." Then  Do
  141.  1490           Rem A "." followed by 2 spaces is assumed to be the end of a sentence
  142.  1500           If I+1<Sector*2 Then If Text$(I+1,I+2)="  " Then End'sentence=I : Goto 1690
  143.  1510           Rem A "." followed by a CR is assumed to be the end of a sentence
  144.  1520           If Text$(I+1,I+1)=Chr$(13) Then End'sentence=I : Goto 1690
  145.  1530           Rem A "." followed by an alphanumeric is not counted as a sentence end
  146.  1540           If Pos(Letters$,Text$(I+1,I+1),0)>-1 Then 1690
  147.  1550           Rem There can be no one word sentences
  148.  1560           Rem This avoids counting "1.  " as the end of a sentence
  149.  1570           If Sentence'words<2 Then 1690
  150.  1580           Rem the last letter in a sentence before a period must be a small letter
  151.  1590           Rem This makes sure that "I. " will not be counted as a sentence
  152.  1600           Rem Delete this statement if checking an UPPER CASE text file
  153.  1610           If Pos(Uppercase$,Text$(I-1,I-1),0)>-1 Then 1690
  154.  1620           Rem Check to see if the next word starts with a CAPITAL LETTER
  155.  1630           J=I
  156.  1640             While Pos(Letters$,Text$(J,J),0)=-1 And J<Finish
  157.  1650             J=J+1
  158.  1660             If J=Sector*2 Then Gosub Get'file : J=J-Sector
  159.  1670             Endwhile
  160.  1680           If Pos(Uppercase$,Text$(J,J),0)>-1 Then End'sentence=I
  161.  1690           Enddo
  162.  1700         Rem "?" and "!" are always assumed to be at the end of sentences
  163.  1710         If Text$(I,I)="?" Then End'sentence=I
  164.  1720         If Text$(I,I)="!" Then End'sentence=I
  165.  1730         Rem Note: ":" and ";" are not counted as sentence terminators
  166.  1740         I=I+1
  167.  1750         If I=Sector*2 Then Gosub Get'file
  168.  1760         Endwhile
  169.  1770       Gosub Wordstart
  170.  1780       Until End'sentence>0 Or I>=Finish
  171.  1790     If End'sentence>-1 Then Sentences=Sentences+1
  172.  1800     Rem If the end of a sentence is not reached before the end of
  173.  1810     Rem the end of the file the end of a sentence is assumed
  174.  1820     If End'sentence=0 Then End'sentence=Finish
  175.  1830     @"* ";Sentences;" *  ";" Words = ";Sentence'words
  176.  1840     @ Text$(Start'sentence,End'sentence) : @
  177.  1850     Until I>=Finish
  178.  1860   Return
  179.  1870 *Count'syllables
  180.  1880   Rem Counts the syllables in a word
  181.  1890   Word'syllables=0
  182.  1900   K=Startword
  183.  1910   Rem Repeats until the end of a word
  184.  1920     Repeat
  185.  1930     Rem Check for a vowel
  186.  1940     If Pos(Vowels$,Text$(K,K),0)>-1 Then  Do
  187.  1950       Rem If one vowel is found check for a second vowel
  188.  1960       If Pos(Vowels$,Text$(K+1,K+1),0)=-1 Then  Do
  189.  1970         Rem "e" is special
  190.  1980         If Text$(K,K)="e" Then  Do
  191.  1990           Rem "e" at the end of a word does not add a syllable unless it
  192.  2000           Rem it preceeded by an "l"
  193.  2010           If K=Endword And Text$(Endword-1,Endword-1)="l" Then Word'syllables=Word'syllables+1
  194.  2020           Rem "ed" at the end of a word does not add a syllabel
  195.  2030           If K=Endword-1 And Text$(Endword,Endword)<>"d" Then Word'syllables=Word'syllables+1
  196.  2040           If Endword-K>1 Then Word'syllables=Word'syllables+1
  197.  2050           Else
  198.  2060           Word'syllables=Word'syllables+1
  199.  2070           Enddo
  200.  2080         Else
  201.  2090         Rem This section is done if there are 2 vowels in a row
  202.  2100         Vowel1=Int(Pos(Vowels$,Text$(K,K),0)/2)+1
  203.  2101         Rem Do not count "y" at the begining of a word as a vowel
  204.  2102         Rem Avoids counting "you" as a 2 syllable word
  205.  2103         If K=Startword And Vowel1=6 Then 2140
  206.  2110         Rem Vowel1    1="a"  2="e"  3="i"  4="o"  5="u"  6="y"
  207.  2120         K=K+1
  208.  2130         On Vowel1 Gosub A's,E's,I's,O's,U's,Y's
  209.  2140         Enddo
  210.  2150       Enddo
  211.  2160     K=K+1
  212.  2170     Until K>Endword
  213.  2180   If Word'syllables=0 Then Word'syllables=1
  214.  2190   If Word'syllables>3 Then Long'words=Long'words+1
  215.  2200   Syllables=Syllables+Word'syllables
  216.  2210   @ Using"####. ",Words;
  217.  2220   @ Text$(Startword,Endword);" - ";Tab(30);Word'syllables;Tab(35);Syllables
  218.  2230   Return
  219.  2240 *Wordstart
  220.  2250     While Pos(Letters$,Text$(I,I),0)=-1 And I<Finish
  221.  2260     If Text$(I,I)="@" Then Gosub Ignore
  222.  2270     I=I+1
  223.  2280     If I=Sector*2 Then Gosub Get'file
  224.  2290     Endwhile
  225.  2300   Return
  226.  2370 *A's
  227.  2380   Rem Count "ao" as two syllables
  228.  2390   If Pos("oO",Text$(K+1,K+1),0)>-1 Then  Do
  229.  2400     Word'syllables=Word'syllables+2
  230.  2460     Else
  231.  2470     Word'syllables=Word'syllables+1
  232.  2480     Enddo
  233.  2490   Return
  234.  2500 *E's
  235.  2510   Rem count "ei" and "eo" as two syllables
  236.  2520   If Pos("iIoO",Text$(K+1,K+1),0)>-1 Then  Do
  237.  2530     Word'syllables=Word'syllables+2
  238.  2540     Else
  239.  2550     Word'syllables=Word'syllables+1
  240.  2560     Enddo
  241.  2570   Return
  242.  2580 *I's
  243.  2590   Rem Count "io" and "iu" as two syllables
  244.  2600   If Pos("oOuU",Text$(K+1,K+1),0)>-1 Then  Do
  245.  2605     Word'syllables=Word'syllables+2
  246.  2610     Rem Count "ion" as one syllable
  247.  2630     If Pos("oO",Text$(K+1,K+1),0)>-1 Then  Do
  248.  2640       If Pos("nN",Text$(K+1,K+1),0)>-1 Then Word'syllables=Word'syllables-1
  249.  2670       Enddo
  250.  2675     Else
  251.  2676     Word'syllables=Word'syllables+1
  252.  2680     Enddo
  253.  2690   Return
  254.  2700 *O's
  255.  2710   Rem Count "oa" and "oe" as two syllables
  256.  2720   If Pos("aAeE",Text$(K+1,K+1),0)>-1 Then  Do
  257.  2730     Word'syllables=Word'syllables+2
  258.  2740     Else
  259.  2750     Word'syllables=Word'syllables+1
  260.  2760     Enddo
  261.  2770   Return
  262.  2780 *U's
  263.  2790   Rem Count "uo" as two syllables
  264.  2800   If Pos("oO",Text$(K+1,K+1),0)>-1 Then  Do
  265.  2810     Word'syllables=Word'syllables+2
  266.  2820     Else
  267.  2830     Word'syllables=Word'syllables+1
  268.  2840     Enddo
  269.  2850   Return
  270.  2860 *Y's
  271.  2870   Rem Count all vowels follwed by "y" as one syllable
  272.  2880   Word'syllables=Word'syllables+1
  273.  2890   Return
  274.  2900 *Ignore
  275.  2910   Rem Skip over the remainder of any line with a "@"
  276.  2920   Rem(The Cromemco Formater control character)
  277.  2930     Repeat
  278.  2940     I=I+1
  279.  2950     If I=Sector*2 Then Gosub Get'file
  280.  2960     Until Text$(I,I)=Chr$(13)
  281.  2970   Return
  282.