home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / WEDITS22.ZIP / WEDICT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-08-18  |  10.6 KB  |  402 lines
  1. UNIT WEDict; {$O+}
  2. { -- Dictionary module for WWIVEdit 2.2
  3.   -- Last Updated 8/15/91
  4.   -- Written by:
  5.   --   Adam Caldwell
  6.   --
  7.   -- This code is limited public domain (see WWIVEDIT.PAS for more details
  8.   --
  9.   -- Purpose: Provide a spell checker for WWIVEdit 2.2
  10.   --
  11.   -- Known Errors: None
  12.   --
  13.   -- Planned Enhancements:
  14.   --   Data Compression on dictionary
  15.   -- }
  16. {$R-,V-,S+,B-,E-,N-}   { These Optomize things as much as possible }
  17.  
  18. INTERFACE
  19.  
  20. PROCEDURE SpellCheck;
  21.  
  22. IMPLEMENTATION
  23.  
  24. USES WEVars, WEMisc, WEString, WELine, WEKbd, WEInput, WEOutput, WETime;
  25.  
  26. TYPE
  27.   Index=ARRAY[0..27,0..27] OF LongInt;
  28.   WordRec=RECORD
  29.     Next   : LongInt;
  30.     Word   : String[25];
  31.   END;
  32.  
  33.  
  34. VAR
  35.   ind :index;
  36.   f:file;
  37.   DictionaryIndexLoaded : boolean;
  38.   posi : longint;
  39.  
  40. FUNCTION CheckSpelling(s:string):boolean;
  41. VAR
  42.   w:wordrec;
  43.   b1,b2 : byte;
  44.   p : longint;
  45.   s1 : string;
  46. BEGIN
  47.   b1:=ord(s[1])-ord('a')+1;
  48.   b2:=ord(s[2])-ord('a')+1;
  49.   IF length(s)=1 THEN b2:=0;
  50.   IF b1>26 THEN b1:=27;
  51.   IF b2>26 THEN b2:=27;
  52.   p:=ind[b1,b2];
  53.   s1:='';
  54.   WHILE (p<>0) AND (s<>s1) DO
  55.   BEGIN
  56.     seek(f,p);
  57.     {$I-} blockread(f,w,Sizeof(wordRec)); {$I+}
  58.     IF IOResult<>0 THEN ;
  59.     p:=w.next;
  60.     s1:=w.word;
  61.   END;
  62.   CheckSpelling:=s=s1;
  63. END;
  64.  
  65. PROCEDURE CloseDictionary;
  66. BEGIN
  67.   IF DicChanged THEN BEGIN
  68.     seek(f,0);
  69.     blockwrite(f,ind,sizeof(index));
  70.   END;
  71.   close(f);
  72. END;
  73.  
  74. PROCEDURE OpenDictionary;
  75. BEGIN
  76.   posi:=0;
  77.   DictionaryIndexLoaded:=FALSE;
  78.   DicChanged:=FALSE;
  79.   assign(f,StartupDir+'SPELL.DAT');
  80.   reset(f,1);
  81.   IF NOT DictionaryIndexLoaded THEN
  82.     BlockRead(f,ind,sizeof(ind));
  83.   DictionaryIndexLoaded:=True;
  84. END;
  85.  
  86.  
  87. FUNCTION Suggest(s:string; VAR startat:integer; newword:boolean):boolean;
  88. VAR
  89.   b1, b2 :byte;
  90.   w : wordrec;
  91.   i : integer;
  92.   weight : longint;
  93.   s1, s2 : string;
  94.  
  95. BEGIN
  96.   IF (newword) THEN BEGIN
  97.     b1:=ord(s[1])-ord('a')+1;
  98.     b2:=ord(s[2])-ord('a')+1;
  99.     IF length(s)=1 THEN b2:=0;
  100.     IF b1>26 THEN b1:=27;
  101.     IF b2>26 THEN b2:=27;
  102.     posi:=ind[b1,b2];
  103.   END;
  104.   seek(f,posi);
  105.   {$I-} blockread(f,w,sizeof(wordrec)); {$I+}
  106.   IF IOResult=0 THEN ;
  107.   weight:=0;
  108.   s1:=w.word;
  109.   FOR i:=1 TO Length(s) DO
  110.     IF (pos(s[i],s1)>0) AND (abs(pos(s[i],s1)-i+weight)<3) THEN
  111.     BEGIN
  112.       delete(s1,pos(s[i],s1),1);
  113.       inc(weight);
  114.     END;
  115.   weight:=0;
  116.   s2:=s;
  117.   FOR i:=1 TO Length(w.word) DO
  118.     IF (pos(w.word[i],s2)>0) AND (abs(pos(w.word[i],s2)-i+weight)<3) THEN
  119.     BEGIN
  120.       delete(s2,pos(w.word[i],s2),1);
  121.       inc(weight);
  122.     END;
  123.   IF ((pos(s1,w.word)+length(s1)-1=length(w.word)) OR (length(s1)<length(s) div 2)) AND
  124.      ((w.word+s2=s                               ) OR (length(s2)<length(s) div 2)) AND
  125.      (abs(length(w.word)-length(s))<length(s1) div 2 + 2) THEN
  126.   BEGIN
  127.     inc(startat);
  128.     Suggestion[startat]:=w.word;
  129.   END;
  130.   posi:=w.next;
  131.   suggest:=posi<>0;
  132. END;
  133.  
  134. PROCEDURE AddChainPointer(n:longint);
  135. VAR
  136.   w : wordrec;
  137.   p : longint;
  138. BEGIN
  139.   p:=n;
  140.   WHILE p<>0 DO
  141.   BEGIN
  142.     n := p;
  143.     seek(f,p);
  144.     BlockRead(f,p,sizeof(longint));
  145.   END;
  146.   seek(f,n);
  147.   p:=FileSize(f);
  148.   BlockWrite(f,p,sizeof(longint));
  149.   Seek(f,FileSize(f));
  150. END;
  151.  
  152.  
  153. PROCEDURE AddWord(s:string);
  154. VAR
  155.   b1, b2 : byte;
  156.   w:wordrec;
  157. BEGIN
  158.   DicChanged:=TRUE;
  159.   b1:=ord(s[1])-ord('a')+1;
  160.   b2:=ord(s[2])-ord('a')+1;
  161.   IF length(s)=1 THEN b2:=0;
  162.   IF b1>26 THEN b1:=27;
  163.   IF b2>26 THEN b2:=27;
  164.   IF ind[b1,b2]=0 THEN
  165.   BEGIN
  166.     Ind[b1,b2]:=FileSize(f);
  167.     seek(f,FileSize(f));
  168.   END
  169.   ELSE
  170.     AddChainPointer(Ind[b1,b2]);
  171.   w.Word:=s;
  172.   w.next:=0;
  173.   BlockWrite(f,w.next,1+sizeof(longint)+ord(w.word[0]));
  174. END;
  175.  
  176.  
  177. FUNCTION Clean(s:string):string;
  178. { -- Remove extraneous characters from string (replace them by blanks) -- }
  179. VAR
  180.   i:integer;
  181. BEGIN
  182.   FOR i:=1 TO length(s) DO
  183.     IF s[i] IN ['A'..'Z'] THEN
  184.       s[i]:=chr(ord(s[i])+32)
  185.     ELSE IF pos(s[i],'-~`!@#$%^&*()_+|\=1234567890{}[]:";<>?,./'+
  186.                      ^A^B^C^D^E^F^G^H^I^K^L^N^O^P^Q^R^S^T^U^V^W^X^Y^Z)>0
  187.       THEN s[i]:=' ';
  188.   Clean:=s;
  189. END;
  190.  
  191. PROCEDURE SpellCheck;
  192. { Do the job of spell checking... What a pain... :-) }
  193. VAR
  194.   f : file;
  195.   l, i, d, n : integer;
  196.   s, s1 : string;
  197.   px, py, sx, sy, p : byte;
  198.   ch : char;
  199.   wt,wb,vt,vb,scy : integer;
  200.   nsug : integer;
  201.   plural : String[1];
  202.   lastsug : integer;
  203.   Fun:EdFun;
  204.   more : boolean;
  205.   Temp : LineType;
  206.   LineChanged : Boolean;
  207.   lt:LongInt;
  208. BEGIN
  209. { -- Initialize Variables, Save Window State, Open Dictionary -- }
  210.   wt:=WindowTop; wb:=WindowBottom;
  211.   vt:=ViewTop; vb:=ViewBottom; scy:=cy;
  212.   WindowTop:=3;  WindowBottom:=WindowTop+3;
  213.   WindowHeight:=WindowBottom-WindowTop;
  214.   ViewTop:=1; ViewBottom:=ViewTop+WindowHeight;
  215.   l:=1;  ch := ' ';
  216.   n:=1; cy:=1; cx:=1;  lt:=0;
  217.   FOR i:=1 TO MaxPhyLines DO
  218.     InitLine(Screen[i]);
  219.   OpenDictionary;
  220. { -- Setup New display -- }
  221.   clrscr;
  222.   print(C2+'Spell Checking');
  223.   print(C0+dup('=',79));
  224.   for i:=1 TO WindowHeight+1 DO
  225.     nl;
  226.   print(dup('=',79));
  227. { -- Start Spell Checking -- }
  228.   WHILE (l<Highline) AND (n<>4) AND (NOT CheckAbort) DO
  229.   BEGIN
  230.     cx:=1; cy:=l;
  231.     s:=Clean(Line[l]^.l);
  232.     WHILE (cx<Length(s)) AND (n<>4) DO
  233.     BEGIN
  234.       s1:=copy(s,cx,length(s)-cx+1);
  235.       p:=pos(' ',s1);
  236.       WHILE (p>0) AND (cx<length(s)) AND (p<2) DO
  237.       BEGIN
  238.         inc(cx);
  239.         s1:=copy(s,cx,length(s)-cx+1);
  240.         p:=pos(' ',s1);
  241.       END;
  242.       IF p=0 THEN p:=length(s)-cx+2;
  243.       s1:=copy(s,cx,p-1);
  244.       IF length(s1)>1 THEN
  245.       BEGIN
  246.         cy:=l;
  247.         IF (cy>ViewBottom) OR (cy<viewTop) THEN BEGIN
  248.           ViewTop:=cy-1;
  249.           IF cy=1 THEN ViewTop:=1;
  250.           ViewBottom:=ViewTop+WindowHeight;
  251.         END;
  252.         IF Timer-Lt>2 THEN BEGIN
  253.           redisplay;
  254.           lt:=timer;
  255.         END;
  256.         IF NOT CheckSpelling(s1) THEN
  257.         BEGIN
  258.           AfterNext:=ClrStatLine2;
  259.           Redisplay;
  260.           px:=Wherex; py:=Wherey;
  261.           Ansic('0');
  262.           ReverseVideoOn;
  263.           prompt(copy(Line[cy]^.l,cx,length(s1)));
  264.           ReverseVideoOff;
  265.           lastsug:=4;
  266.           Suggestion[2]:='<Edit>';
  267.           Suggestion[1]:='<Ignore>';
  268.           Suggestion[3]:='<Add>';
  269.           Suggestion[4]:='<Quit>';
  270.           nsug:=4;
  271.           more := Suggest(s1,nsug,true);
  272.           n:=1;
  273.           FOR i:=1 TO nsug DO
  274.           BEGIN
  275.             IF i=n THEN ansic('4');
  276.             gotoxy(20*((i-1) mod 4)+1,(i-1) div 4+WindowBottom+3);
  277.             write(Suggestion[i]);
  278.             IF i=n THEN ansic('0');
  279.           END;
  280.           REPEAT
  281.             WHILE more AND NOT Keypressed DO
  282.             BEGIN
  283.               more:=Suggest(s1,nsug,false);
  284.               IF (more) AND (nsug>lastsug) THEN BEGIN
  285.                 ansic('0');
  286.                 gotoxy(20*((nsug-1) mod 4)+1,(nsug-1) div 4+WindowBottom+3);
  287.                 write(Suggestion[nsug]);
  288.                 lastsug:=nsug;
  289.               END;
  290.               gotoxy(20*((n-1) mod 4)+1,(n-1) div 4+WindowBottom+3);
  291.             END;
  292.             IF (NOT More) AND (nsug=4) THEN BEGIN
  293.               gotoxy(1,4+windowbottom);
  294.               prompt(C2+'No suggested spellings.');
  295.             END ELSE IF (NOT More) AND (LastSug>0) THEN BEGIN
  296.               gotoxy(20*(nsug mod 4)+1,nsug div 4+windowbottom+3);
  297.               prompt(C2+'End of Suggestions');
  298.               LastSug:=0;
  299.             END;
  300.             gotoxy(20*((n-1) mod 4)+1,(n-1) div 4+WindowBottom+3);
  301.             fun:=GetArrow;
  302.             IF fun IN [Up,Down,Left,Right] THEN
  303.             BEGIN
  304.               ansic('0');
  305.               write(Suggestion[n]);
  306.               CASE fun OF
  307.                 Up   : Dec(n,4);
  308.                 Down : Inc(n,4);
  309.                 Left : Dec(n);
  310.                 Right: Inc(n);
  311.               END;
  312.               IF n<1 THEN n:=n+Nsug
  313.               ELSE IF n>Nsug THEN n:=n-NSug;
  314.               gotoxy(20*((n-1) mod 4)+1,(n-1) div 4+WindowBottom+3);
  315.               ansic('4');
  316.               write(suggestion[n]);
  317.               gotoxy(20*((n-1) mod 4)+1,(n-1) div 4+WindowBottom+3);
  318.             END;
  319.           UNTIL Fun IN [Enter];
  320.           IF (n=3) AND ((thisuser.sl>addsl) OR Local) THEN
  321.             AddWord(s1)
  322.           ELSE IF (n=3) THEN BEGIN
  323.             write(^G);
  324.             gotoxy(1,ScreenHeight-2);
  325.             Prompt(C2+'Insufficient priviledge.  Sorry...');
  326.           END;
  327.           IF n<>4 THEN
  328.           BEGIN
  329.             ansic('0');
  330.             FOR i:=-1 TO nsug DIV 4 +1 DO
  331.             BEGIN
  332.               gotoxy(1,i + windowbottom+3);
  333.               clreol;
  334.             END;
  335.             gotoxy(px,py);
  336.             ansic('0');
  337.             prompt(copy(Line[cy]^.l,cx,length(s1)));
  338.           END;
  339.           IF n=2 THEN BEGIN
  340.             gotoxy(1,windowbottom+4);
  341.             print(C2+'Enter new spelling, <ENTER>=Ignore');
  342.             prompt(C4+dup(' ',20)+#27'[20D');
  343.             {$V-}
  344.             input(Suggestion[nsug+1],20);
  345.             {$V+}
  346.             IF suggestion[nsug+1]<>'' THEN n:=nsug+1 ELSE n:=1;
  347.             ansic('0');
  348.             gotoxy(1,windowbottom+4);
  349.             clreol;
  350.             gotoxy(1,windowbottom+5);
  351.             clreol;
  352.           END;
  353.           IF n>4 THEN BEGIN
  354.             Line[0]^.HardCR:=Line[cy]^.HardCR;
  355.             Line[0]^.l:=copy(Line[cy]^.l,cx,len(cy)-cx+1);
  356.             Line[0]^.c:=copy(Line[cy]^.c,cx,len(cy)-cx+1);
  357.             LDelete(cy,cx,len(cy)-cx+1);
  358.             Line[cy]^.HardCR:=FALSE;
  359.             ch:=Line[0]^.c[1];  { save color of first deleted character }
  360.             Ldelete(0,1,length(s1));
  361.             IF len(0)+length(suggestion[n])>LineLen THEN BEGIN
  362.               InsertLine(cy+1,Line[0]^);
  363.               InitLine(Line[0]^);
  364.               Temp.HardCR:=FALSE;
  365.             END;
  366.             Temp.l:=Suggestion[n];
  367.             Temp.c:=dup(ch,length(suggestion[n]));
  368.             LInsert(Temp,0,1);
  369.             InsertLine(cy+1,Line[0]^);
  370.             IF cx=1
  371.               THEN DeleteLine(cy)
  372.               ELSE Reformat(cy,true);
  373.             Redisplay;
  374.             s:=Clean(Line[cy]^.l);
  375.             IF (length(suggestion[n])<>length(s1)) AND (n<>nsug+1) THEN
  376.               cx:=cx-length(s1)+length(suggestion[n])
  377.           END;
  378.         END;
  379.       END;
  380.       IF (n<>nsug+1) THEN
  381.         cx:=cx+p
  382.       ELSE n:=1;
  383.     END;
  384.     inc(l);
  385.   END;
  386. { -- Close Dictionary, restore Window, Force Redisplay -- }
  387.   CloseDictionary;
  388.   windowtop:=wt; windowbottom:=wb; windowheight:=wb-wt;
  389.   IF cy=scy THEN
  390.   BEGIN
  391.     ViewTop:=vt;
  392.     ViewBottom:=vb;
  393.   END ELSE ViewTop:=cy-2;
  394.  
  395.   IF ViewTop<1 THEN ViewTop:=1;
  396.   ViewBottom:=ViewTop+WindowHeight;
  397.   BeforeNext:=DoNothing;
  398.   AfterNext:=DoNothing;
  399.   ForcedRedisplay;
  400. END;
  401.  
  402. END.