CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug080.ark / GRADER.STB < prev next >

Wrap

Text File | 1984-04-29 | 11.8 KB | 283 lines

10 Gosub Screen'erase 20 @"Text Analyzing Program" 30 @"By David E. Trachtenbarg" 40 @"Version 04/14/81" 50 Integer Sector 60 Sector=128 70 Dim Text$(Sector*2),Eof$(1),String$(10),Text'file$(13) 80 Dim Uppercase$(25),Lowercase$(25),Numbers$(10),Letters$(63) 90 Dim Vowels$(11),Consonants$(39),End'of'word$(19) 100 Integer I,J,K,Record,Words,Sentences,Finish 110 Integer Startword,Endword,Start'sentence,End'sentence 120 Integer Sentence'words,Long'words,Vowel1 140 Long Average'words,Average'syllables,Reading'ease,Fog'index 150 Uppercase$="ABCDEFGHIJKLMNOPQRSTUVWXYZ" 160 Lowercase$="abcdefghijklmnopqrstuvwxyz" 170 Vowels$="aAeEiIoOuUyY" 180 Consonants$="bBcCdDeEfFgGhHjJkKlLmMnNpPqQrRsStTvVwWxXzZ" 190 End'of'word$=" ?!;:()+/=&[]{}#"""+Chr$(13) 200 Numbers$="0123456789" 210 Letters$=Uppercase$+Lowercase$+Numbers$ 220 Eof$=Chr$(26)+Chr$(27) 230 Rem Set 0,-1 prevents auto CR at end of 80 char string on console 240 Set 0,-1 250 Gosub Enter'text'file 260 Record=-1 270 Words=0 280 Sentences=0 290 Syllables=0 300 Long'words=0 310 Open\1\Text'file$ 320 On Esc Goto Display'results 340 Gosub Get'file 350 Gosub Count 380 *Display'results 390 Close 400 @ : @ : @"File: ";Text'file$ : @ 410 @"Words = ";Words 420 @"Sentences = ";Sentences 430 @"Syllables = ";Syllables 440 @"Words with 3 or more syllables = ";Long'words 450 Average'words=1.0*(Words/Sentences) 460 @ : @"Average number of words per sentence = "; 470 @ Using"###.#",Average'words 480 Average'syllables=100.0*(Syllables/Words) 490 @"Syllables per 100 words = "; 500 @ Using"####",Average'syllables 510 Reading'ease=206.835-((Average'words*1.015)+(Average'syllables*0.846)) 520 @ : @"Reading ease = "; 530 @ Using"####.#",Reading'ease; 540 If Reading'ease>=90 Then @" Comics - 4th grade 93"; 550 If Reading'ease>=80 And Reading'ease<90 Then @" Pulp fiction - 5th grade 91"; 560 If Reading'ease>=70 And Reading'ease<80 Then @" Slick fiction - 6th grade 88"; 570 If Reading'ease>=60 And Reading'ease<70 Then @" Digests - 8th grade 83"; 580 If Reading'ease>=50 And Reading'ease<60 Then @" Quality - High School 54"; 590 If Reading'ease>=30 And Reading'ease<50 Then @" Academic - College 33"; 600 If Reading'ease<30 Then @" Scientific - Graduate School 5"; 610 @"% of all U.S. adults." 620 Fog'index=0.4*(Words/Sentences+100.0*Long'words/Words) 630 @ : @"Grade level by Fog Index = "; 640 @ Using"###.#",Fog'index 650 @ : @ 660 End 670 *Screen'erase 680 Out 1,126 : Out 1,28 : Return 690 *Enter'text'file 700 Rem Enter the name of a text file 710 Repeat 720 Set 3,0 730 @ : Input"Enter the name of the text file. ",Text'file$ 740 On Error Goto 770 750 Open\1\Text'file$ 760 Close\1\ 770 If Sys(3)>0 Then Do 780 @ : @"Error ";Sys(3);" has occured." 790 If Sys(3)=128 Or Sys(3)=134 Then @"File does not exist on disk." 800 If Sys(3)=129 Then @"Please enter a filename." 810 If Sys(3)=131 Then Close\1\ : @"File not ready. Please try again." 820 Enddo 830 Until Sys(3)=0 840 On Error Stop 850 Return 860 *Get'file 870 Rem Read in the text file a sector at a time 880 Rem Store the text file in Text$ variable 910 Text$(0,Sector-1)=Text$(Sector,Sector*2-1) 920 Record=Record+1 930 Get\1,Record\Text$(Sector,Sector*2-1) 940 Finish=Pos(Text$,Eof$(0,0),0) 950 If Finish=-1 Then Finish=Sector*2 960 I=Sector 970 Startword=Startword-Sector 980 Start'sentence=Start'sentence-Sector 990 Return 1000 *Count 1010 Rem Analyzes text 1030 Rem Repeats until an end of file condition is reached 1040 Repeat 1050 Gosub Wordstart 1060 Start'sentence=I 1070 Sentence'words=0 1080 End'sentence=0 1090 Rem Repeats until the end of a sentence 1100 Repeat 1110 Gosub Wordstart 1140 Startword=I 1150 Endword=0 1160 Rem Loops until the end of a word is found 1170 While Endword=0 And I<Finish 1180 Rem Check to see of alphanumerics are present 1190 If Pos(Letters$,Text$(I,I),0)=-1 Then Do 1200 If Pos(End'of'word$,Text$(I,I),0)>-1 Then Endword=I-1 1210 Rem Numbers such as 2.345 are counted as one word 1220 If Text$(I,I)="." Then Do 1230 If Pos(Numbers$,Text$(I+1,I+1),0)=-1 Then Endword=I-1 1240 Enddo 1250 Rem Numbers such as 2,123 are counted as one word 1260 If Text$(I,I)="," Then Do 1270 If Pos(Numbers$,Text$(I+1,I+1),0)=-1 Then Endword=I-1 1280 Enddo 1290 Rem Hyphenated words are counted as two words 1300 Rem A hyphen at the end of a line is assumed to broken word 1310 If Text$(I,I)="-" Then Do 1320 If Text$(I+1,I+1)=Chr$(13) Then Do 1330 I=I+2 1340 If I>=Sector Then Gosub Get'file 1350 Else 1360 Endword=I-1 1370 Enddo 1380 Enddo 1390 Enddo 1400 If Endword=0 Then I=I+1 1410 If I=Sector*2 Then Gosub Get'file 1420 Endwhile 1430 Words=Words+1 1440 Sentence'words=Sentence'words+1 1450 Gosub Count'syllables 1460 Rem Check for the end of a sentence 1470 While Pos(Letters$,Text$(I,I),0)=-1 And Text$(I,I)<>"@" And I<=Finish 1480 If Text$(I,I)="." Then Do 1490 Rem A "." followed by 2 spaces is assumed to be the end of a sentence 1500 If I+1<Sector*2 Then If Text$(I+1,I+2)=" " Then End'sentence=I : Goto 1690 1510 Rem A "." followed by a CR is assumed to be the end of a sentence 1520 If Text$(I+1,I+1)=Chr$(13) Then End'sentence=I : Goto 1690 1530 Rem A "." followed by an alphanumeric is not counted as a sentence end 1540 If Pos(Letters$,Text$(I+1,I+1),0)>-1 Then 1690 1550 Rem There can be no one word sentences 1560 Rem This avoids counting "1. " as the end of a sentence 1570 If Sentence'words<2 Then 1690 1580 Rem the last letter in a sentence before a period must be a small letter 1590 Rem This makes sure that "I. " will not be counted as a sentence 1600 Rem Delete this statement if checking an UPPER CASE text file 1610 If Pos(Uppercase$,Text$(I-1,I-1),0)>-1 Then 1690 1620 Rem Check to see if the next word starts with a CAPITAL LETTER 1630 J=I 1640 While Pos(Letters$,Text$(J,J),0)=-1 And J<Finish 1650 J=J+1 1660 If J=Sector*2 Then Gosub Get'file : J=J-Sector 1670 Endwhile 1680 If Pos(Uppercase$,Text$(J,J),0)>-1 Then End'sentence=I 1690 Enddo 1700 Rem "?" and "!" are always assumed to be at the end of sentences 1710 If Text$(I,I)="?" Then End'sentence=I 1720 If Text$(I,I)="!" Then End'sentence=I 1730 Rem Note: ":" and ";" are not counted as sentence terminators 1740 I=I+1 1750 If I=Sector*2 Then Gosub Get'file 1760 Endwhile 1770 Gosub Wordstart 1780 Until End'sentence>0 Or I>=Finish 1790 If End'sentence>-1 Then Sentences=Sentences+1 1800 Rem If the end of a sentence is not reached before the end of 1810 Rem the end of the file the end of a sentence is assumed 1820 If End'sentence=0 Then End'sentence=Finish 1830 @"* ";Sentences;" * ";" Words = ";Sentence'words 1840 @ Text$(Start'sentence,End'sentence) : @ 1850 Until I>=Finish 1860 Return 1870 *Count'syllables 1880 Rem Counts the syllables in a word 1890 Word'syllables=0 1900 K=Startword 1910 Rem Repeats until the end of a word 1920 Repeat 1930 Rem Check for a vowel 1940 If Pos(Vowels$,Text$(K,K),0)>-1 Then Do 1950 Rem If one vowel is found check for a second vowel 1960 If Pos(Vowels$,Text$(K+1,K+1),0)=-1 Then Do 1970 Rem "e" is special 1980 If Text$(K,K)="e" Then Do 1990 Rem "e" at the end of a word does not add a syllable unless it 2000 Rem it preceeded by an "l" 2010 If K=Endword And Text$(Endword-1,Endword-1)="l" Then Word'syllables=Word'syllables+1 2020 Rem "ed" at the end of a word does not add a syllabel 2030 If K=Endword-1 And Text$(Endword,Endword)<>"d" Then Word'syllables=Word'syllables+1 2040 If Endword-K>1 Then Word'syllables=Word'syllables+1 2050 Else 2060 Word'syllables=Word'syllables+1 2070 Enddo 2080 Else 2090 Rem This section is done if there are 2 vowels in a row 2100 Vowel1=Int(Pos(Vowels$,Text$(K,K),0)/2)+1 2101 Rem Do not count "y" at the begining of a word as a vowel 2102 Rem Avoids counting "you" as a 2 syllable word 2103 If K=Startword And Vowel1=6 Then 2140 2110 Rem Vowel1 1="a" 2="e" 3="i" 4="o" 5="u" 6="y" 2120 K=K+1 2130 On Vowel1 Gosub A's,E's,I's,O's,U's,Y's 2140 Enddo 2150 Enddo 2160 K=K+1 2170 Until K>Endword 2180 If Word'syllables=0 Then Word'syllables=1 2190 If Word'syllables>3 Then Long'words=Long'words+1 2200 Syllables=Syllables+Word'syllables 2210 @ Using"####. ",Words; 2220 @ Text$(Startword,Endword);" - ";Tab(30);Word'syllables;Tab(35);Syllables 2230 Return 2240 *Wordstart 2250 While Pos(Letters$,Text$(I,I),0)=-1 And I<Finish 2260 If Text$(I,I)="@" Then Gosub Ignore 2270 I=I+1 2280 If I=Sector*2 Then Gosub Get'file 2290 Endwhile 2300 Return 2370 *A's 2380 Rem Count "ao" as two syllables 2390 If Pos("oO",Text$(K+1,K+1),0)>-1 Then Do 2400 Word'syllables=Word'syllables+2 2460 Else 2470 Word'syllables=Word'syllables+1 2480 Enddo 2490 Return 2500 *E's 2510 Rem count "ei" and "eo" as two syllables 2520 If Pos("iIoO",Text$(K+1,K+1),0)>-1 Then Do 2530 Word'syllables=Word'syllables+2 2540 Else 2550 Word'syllables=Word'syllables+1 2560 Enddo 2570 Return 2580 *I's 2590 Rem Count "io" and "iu" as two syllables 2600 If Pos("oOuU",Text$(K+1,K+1),0)>-1 Then Do 2605 Word'syllables=Word'syllables+2 2610 Rem Count "ion" as one syllable 2630 If Pos("oO",Text$(K+1,K+1),0)>-1 Then Do 2640 If Pos("nN",Text$(K+1,K+1),0)>-1 Then Word'syllables=Word'syllables-1 2670 Enddo 2675 Else 2676 Word'syllables=Word'syllables+1 2680 Enddo 2690 Return 2700 *O's 2710 Rem Count "oa" and "oe" as two syllables 2720 If Pos("aAeE",Text$(K+1,K+1),0)>-1 Then Do 2730 Word'syllables=Word'syllables+2 2740 Else 2750 Word'syllables=Word'syllables+1 2760 Enddo 2770 Return 2780 *U's 2790 Rem Count "uo" as two syllables 2800 If Pos("oO",Text$(K+1,K+1),0)>-1 Then Do 2810 Word'syllables=Word'syllables+2 2820 Else 2830 Word'syllables=Word'syllables+1 2840 Enddo 2850 Return 2860 *Y's 2870 Rem Count all vowels follwed by "y" as one syllable 2880 Word'syllables=Word'syllables+1 2890 Return 2900 *Ignore 2910 Rem Skip over the remainder of any line with a "@" 2920 Rem(The Cromemco Formater control character) 2930 Repeat 2940 I=I+1 2950 If I=Sector*2 Then Gosub Get'file 2960 Until Text$(I,I)=Chr$(13) 2970 Return