program fig; const ksize = 16; {buffer size for block reads, in kilobytes} bsize = 16384; {same thing, in bytes} var ctail: string[30] absolute $80; {CP/M command tail} clen: byte absolute ctail; {length byte} firstswitch: byte; {switch variables} switchE: boolean; switchS: boolean; switchV: boolean; source: string[14]; {file name parsed from ctail} filvar: file; {untyped file for block read} remain: integer; {blocks left in file} toread: integer; {blocks to read in each pass} toscan: integer; {how many bytes to scan} buffer: array[1..bsize] of byte; {holding tank for data} cpoint: integer; {current pointer} cchar: integer; {current character} ascii: array[0..127] of integer; {character counts} enough: boolean; {read enough yet?} insent: boolean; {are we in a word?} inword: boolean; {or a sentence?} wordcount: integer; {how many words?} sentcount: integer; {how many sentences?} wordlen: integer; {how long is the word?} md, {simple counting units} mw, lw, sf: integer; ave, {real numbers for calculations} sfr, lwr, mwr, swr, fog: real; label bed; {point to exit routine} procedure blip; {just print a blip on the screen} begin {to let user know we didn't fall asleep} write('.'); end; procedure endword; begin inword := false; if (wordlen>=5) and (wordlen<10) then md := md + 1; if (wordlen=8) then mw := mw + 1; if (wordlen=9) then lw := lw + 1; if (wordlen>9) then sf := sf + 1; end; {main program} begin if clen<=1 then {if NO command tail, print help} begin; writeln('Use: FIG filename.typ /options'); writeln; writeln(' Default mode gives FOG Index, word count, sentence count,'); writeln(' average words/sentence, percentages of long, medium, and'); writeln(' short words.'); writeln; writeln(' /E option reads Entire file. Otherwise FIG only samples'); writeln(' the first ', ksize, 'K of text.'); writeln; writeln(' /S option gives "Suggest" mode. Default statistics, plus'); writeln(' suggestions to improve readability.'); writeln; writeln('Options may be combined in any order, so "FIG myfile /S/E"'); writeln('and "FIG myfile /E/S" do the same thing.'); goto bed; end; if clen>30 then clen:=30; {Got command? Trim it} switchE := (pos('/E',ctail) > 0); {Find E switch} switchS := (pos('/S',ctail) > 0); {Find S switch} switchV := (pos('/V',ctail) > 0); {Find V switch} firstswitch := pos('/',ctail); {parse file name} if firstswitch = 0 then source := copy(ctail,2,clen) else source := copy(ctail,2,firstswitch-2); repeat enough := false; assign(filvar,source); {check if file exists} {$I-} reset(filvar); {$I+} {try to open it} enough := (IOresult = 0); if not enough then begin writeln ('File ', source, ' not found'); write ('Re-enter name or ^C to quit: '); readln(source); for cpoint := 1 to 14 do source[cpoint] := upcase(source[cpoint]); end; until enough; {data initialization section} blip; for cpoint := 1 to bsize do buffer[cpoint] := 0; for cpoint := 0 to 127 do ascii[cpoint] := 0; cpoint := 0; enough := false; insent := false; inword := false; wordcount := 0; sentcount := 0; wordlen := 0; md := 0; mw := 0; lw := 0; sf := 0; ave := 0; sfr := 0; lwr := 0; mwr := 0; swr := 0; fog := 0; blip; {primary reading and analysis} remain := filesize(filvar); {how many records in file} repeat write(','); {kinda like blip, for reads} toread := remain; if remain >= 128 then toread := 128; remain := remain - toread; toscan := toread*128; {how many bytes to scan} blockread(filvar,buffer,toread); {go get them} repeat cpoint := cpoint + 1; {point into buffer} cchar := buffer[cpoint] and 127; {strip control bit} case cchar of 39, {apostrophe} 48..57, {digits 0-9} 65..90, {chars A-Z} 97..122: begin {chars a-z} if (not insent) then begin sentcount := sentcount + 1; insent := true; end; if (not inword) then begin inword := true; wordcount := wordcount + 1; wordlen := 0; end; wordlen := wordlen + 1 end; 33,46,63: begin {exp, prd, qm} insent := false; if inword then endword; end; else; {anything else} if inword then endword; if cchar = 26 then enough := true; end; ascii[cchar] := ascii[cchar] + 1; until enough or (cpoint=toscan); cpoint := 0; until (remain = 0) or (not switchE); blip; {final calculation block} ave := wordcount/sentcount; {average words per sentence} sfr := sf+(lw*0.8)+(mw*0.45); {special function words} lwr := (sfr*100.0)/wordcount; {% long words} mwr := (md*100.0)/wordcount; {% medium words} swr := 100.0-(lwr+mwr); {% short words} fog := (ave+lwr)*0.4; {FOG index} writeln; write ('FOG Index: ', fog:4:1); if remain = 0 then writeln else writeln(' (based on sample only)'); write (wordcount, ' words in ', sentcount, ' sentences, '); writeln (ave:4:1, ' average w/s.'); write ('Short words:', swr:5:1, '% '); write ('Medium:', mwr:5:1, '% '); writeln ('Long:', lwr:5:1, '% '); if switchS then {print suggestions and/or warnings} begin; writeln; if wordcount < 100 then writeln('Small sample; results may be off'); if fog < 6 then writeln('Low FOG index; simplisitc or choppy style?'); if fog > 10 then writeln('High FOG index; complex or overbearing style?'); if ave < 8 then writeln('Short sentences; choppy?'); if ave > 18 then writeln('Long sentences; verbose?'); if swr < 50 then writeln('Less than 50% short words; try using fewer big words'); if (ascii[33]*8) > sentcount then writeln(ascii[33], ' exclamations; over-excited?'); if (ascii[63]*5) > sentcount then writeln(ascii[63], ' questions; rhetorical?'); if (ascii[59]*3) > sentcount then writeln(ascii[59], ' semi-colons; possible sentence breaks?'); if (ascii[44]*1) > sentcount then writeln(ascii[44], ' commas; possible sentence breaks?'); if (ascii[40]*4) > sentcount then writeln(ascii[40], ' parenthetical remarks (at least); could any stand alone?'); if (ascii[40]<>ascii[41]) then begin write(ascii[40], ' open parens, '); write(ascii[41], ' close parens; '); writeln('unbalanced?'); end; if (ascii[91]<>ascii[93]) then begin write(ascii[91], ' open brackets, '); write(ascii[93], ' close brackets; '); writeln('unbalanced?'); end; if (ascii[123]<>ascii[125]) then begin write(ascii[123], ' open braces, '); write(ascii[125], ' close braces; '); writeln('unbalanced?'); end; end; {if switchS} bed: {say goodnight, gracie!} end.