udict.pas

Delphi for fun library v12, latest. This is the library for manuplating list, combination-permutati

   LoadDicFromFile(LargeDic);
   ini.free;
 End;

 {******************** TDic.CheckSave *******************}
 function TDic.Checksave:integer;
 {Ask user if changed dictionary is to be saved}
   Begin
     result:=messagedlg('Save '+dicname+'?',mtconfirmation,mbyesnocancel,0);
     if result=mryes then SaveDicTofile(dicname);
   End;


function TDic.GetDicSize:integer;
begin
  result:=words.count;
end;  


 {******************** TDic.SaveDicToFile *******************}
 Procedure TDic.SaveDicToFile(filename:string);
 var
   f:text;
   w:string;
   a,fr,caps:boolean;
 Begin
   If not fileexists(filename) or ( fileexists(Filename)  and
     (MessageDlg('Overwrite '+filename +'?',mtconfirmation,[mbYes, mbNo],0)=
       mrYes)) then
   begin
     if lowercase(extractfileext(filename))='.txt' then
     begin
       assignfile(f,filename);
       rewrite(f);
       setrange('a',1,dichighletter{'z'},maxwordlength);
       while getnextword(w,a,fr,caps) do writeln(f,w);
       closefile(f);
     end
     else words.Savetofile(filename);
     dicdirty:=false;
   end;
 End;

 {******************* TDic.SaveDicToTextFile *****************}
 Procedure TDic.SaveDicToTextFile(filename:string);
 {save dictionary}
 var
   textname:string;
   f:textfile;
   w:string;
   a,fo,caps,useprops:boolean;
 Begin
   textname:=changefileext(filename,'.txt');
   If not fileexists(textname) or ( fileexists(textname)  and
     (MessageDlg('Overwrite '+textname +'?',mtconfirmation,[mbYes, mbNo],0)=
       mrYes)) then
   Begin
     assignfile(f,textname);
     rewrite(f);
     setrange('a',1,dichighletter{'z'},maxwordlength);
     If messagedlg('Include properties (abbrev,foreign,caps) in output?',
                      mtconfirmation,[mbyes,mbno],0)=mryes
     then useprops:=true
     else useprops:=false;

     while getnextword(w,a,fo,caps) do
     Begin
       if useprops then
       begin
         if a then w:=w+',A';
         if fo then w:=w+',F';
         if caps then
         Begin
          w[1]:=upcase(w[1]);
          w:=w+',C';
         end
       end;
       writeln(f,w);
     End;
     closefile(f);
   End;
 End;

{******************* TDic.Rebuildindex ****************}
Procedure TDic.Rebuildindex;
{Build the index which contains a cumulative count of words beginning with
 each letter - called after each insertion or deletion}

var
  a,prevletter,letter:char;
  letterstocopy, n:byte;
  i,wordlength:integer;
Begin
  for a:='a' to high(letterindex) do Letterindex[a]:=-1;
  prevletter:=pred('a');
  letter:='a';
  maxwordlength:=0;
  abbrevcount:=0;
  foreigncount:=0;
  capscount:=0;
  totalcount:=words.count;
  for i:=0 to words.count-1 do
  Begin
    n:=ord(words[i][1]);
    if n and $40 >0 then inc(abbrevcount);
    if n and $20 >0 then inc(foreigncount);
    if n and $10 >0 then inc(capscount);
    letterstocopy:=n and $0F;
    wordlength:=letterstocopy+length(words.strings[i])-1;
    if wordlength>maxwordlength then maxwordlength:=wordlength;

    if letterstocopy=0 then letter:=words[i][2];  {new letter}
    if letter <> prevletter then
    Begin
      for a := succ(prevletter) to letter do letterindex[a]:=i;
      prevletter:=letter;
    End;
  End;
  if letter<>dichighletter{'z'} {there were no words with last letter}
  then
  begin  {set all starting letter to highest index}
    for a:=letter to high(letterindex) do letterindex[a]:=words.count-1
  end
  else letterindex[high(letterindex)]:=words.count;
  indexdirty:=false;
End;


{******************** TDic.reSortRange **********************}
procedure TDic.reSortRange;
{fixup mis-sorted dictionary by deleting and inserting words that are
 out of sequence}
var
  w1,w2:string;
  a,f,c:boolean;
  insequence:boolean;
begin
    {find insert point}
    saverange;
    repeat
      insequence:=true;
      setrange(startletter,1,endletter,maxwordlength);
      getnextword(w1,a,f,c);
      while getnextword(w2,a,f,c) and insequence do
      begin
        If (w2<>'') and (w2<=w1) then
        begin
        {oh-oh,  w2 <=w1}
         words.delete(currentwordindex);
         addword(w2,a,f,c);
         insequence:=false;
        end;
        w1:=w2;
      end;
    until insequence;
    indexdirty:=true;
    DicDirty:=true;
    restorerange;
  End;

{***************** GetNextWord **********************}
{Warning!  the values for CurrentWordindex Currword, and PrevWord set
 by GetNextWord are used by other routines and shouldn't be changed
}
Function TDic.GetnextWord(var word:string;var abbrev,foreign,caps:boolean):boolean;
{Get the next word from dictionary within range}
Begin
  result:=false;
  repeat
    prevword:=currword;
    currword:='';
    inc(currentWordIndex);
    if (endletter<dichighletter) then
    begin
      {Check for end of this range}
      if (currentwordindex>=Letterindex[succ(endletter)])
      then exit;
    end
    else if (currentwordindex>=words.count) then exit;

    if currentwordindex>words.count-1 then exit;
    currword:=words[CurrentWordIndex];
    currword:=expandword(prevword,currword,abbrev,foreign,caps);
    If currword[1]>endletter then exit;
    If (startlength<=length(currword)) and (length(currword)<=endlength)
    then result:=true;
  until result=true;
  word:=currword;
End;



{***************** GetNextWord **********************}
{Warning!  the values for CurrentWordindex Currword, and PrevWord set
 by GetNextWord are used by other routines and shouldn't be changed
}
Function TDic.GetnextWord(var word:string;var wordnbr:integer; var abbrev,foreign,caps:boolean):boolean;
{Get the next word from dictionary within range - overloaded version returns word number}
Begin
  result:=false;
  repeat
    prevword:=currword;
    currword:='';
    inc(currentWordIndex);

    if (endletter<>dichighletter) and (currentwordindex>=Letterindex[succ(endletter)]) then exit;
    if currentwordindex>words.count-1 then exit;
    currword:=words[CurrentWordIndex];
    currword:=expandword(prevword,currword,abbrev,foreign,caps);
    If currword[1]>endletter then exit;
    If (startlength<=length(currword)) and (length(currword)<=endlength)
    then
    begin
      result:=true;
      wordnbr:=currentwordindex;
      word:=currword;
    end;
  until result=true;
  
End;

{****************** TDic.IsValidword ********************}
Function TDic.Isvalidword(var s:string):boolean;
{return true if the word has valid format - not necessarily in dictionary}
var
  i:integer;
Begin
  s:=ansilowerCase(s);
  result:=false;
  If (length(s)=0) or (length(s)>maxwordlength) then exit;
  for i:=1 to length(s) do if (not (s[i] in ['a'..dichighletter{'z'}])) then exit;
  result:=true;
End;



Function TDic.GetWordByNumber(n:integer; var word:string):boolean;
{retrieve word number N from the expanded word list}
Begin
  If n<ExpandedList.count then
  Begin
    word:=ExpandedList[n];
    result:=true;
  End
  else
  Begin
    word:='';
    result:=false;
  End;
End;

{***************** LookUp *****************}
Function TDic.Lookup(s:string; var abbrev,foreign,caps:boolean):boolean;
{lookup word "s" in the current dictionary}
var
  start:char;
  testword:string;
  belowit:boolean;
  len,origlen:integer;

  Begin
  result:=false;
  s:=lowercase(s);
  if length(s)=0 then exit;
  if prechecked or IsValidword(s) then
  Begin
    start:=s[1];
    len:=length(s);
    saverange;
    setrange(start,len,start,len);
    belowit:=true;
    while  belowit do
    Begin
      if not getnextword(testword,abbrev,foreign,caps)
      then belowit:=false;
      origlen:=length(testword);
      if (testword>=s) then belowit:=false;
    End;
    if (testword=s) and (origlen=len) then result:=true;
    restorerange;
  End;
End;


 procedure TDic.saverange;
   begin
      savestartletter:=startletter;
      saveendletter:=endletter;
      savestartlength:=startlength;
      saveendlength:=endlength;
   end;

 procedure TDic.restorerange;
   begin
      {restore range info}
      startletter:=savestartletter;
      endletter:=saveendletter;
      startlength:=savestartlength;
      endlength:=saveendlength;
    end;

{****************** AddWord *****************}
Function TDic.AddWord(s:String; abbrev,foreign,caps:boolean):boolean;
{Add word s to dictionary}
var
  newword, nextword,w:string;
  a,f,c:boolean;
Begin
  s:=lowercase(s);
  if (not prechecked) and (not IsValidword(s)) then
  Begin
    result:=false;
    exit;
  End;
  If not lookup(s,a,f,c) then
  Begin
    {find insert point}
    saverange;
    setrange(s[1],1,s[1],maxwordlength);
    while getnextword(w,a,f,c) and (w<s) do;
    newword:=Compressword(prevword,s, abbrev,foreign,caps);
    nextword:=expandword(s,words[currentwordindex],a,f,c);
    words.Insert(currentwordindex,newword);
    words[Currentwordindex+1]:=Compressword(s,nextword,a,f,c);
    if length(s)>maxwordlength then maxwordlength:=length(s);
    result:=true;
    indexdirty:=true;
    DicDirty:=true;
    restorerange;
  End
  else result:=false;
end;

{****************** RemoveWord *****************}
Function TDic.RemoveWord(s:String):boolean;
{Remove word s from dictionary}
var
  nextword:string;
  a,f,c:boolean;
Begin
  If not IsValidword(s) then
  Begin
    result:=false;
    exit;
  End;
  result:=true;
  If lookup(s,a,f,c) then
  begin
    nextword:=expandWord(s,words[succ(CurrentWordIndex)],a,f,c);
    words.delete(currentwordindex);
    words[currentwordindex]:=CompressWord(prevword,nextword,a,f,c);
    IndexDirty:=true;
    DicDirty:=true;
  End;
end;



{****************** SetRange ********************}
Procedure TDic.Setrange(const letter1:char;length1:byte;
                        const letter2:char;length2:byte);
{set a range of letters and lengths to search}
var
  s1,s2:string;
Begin
  s1:=ansilowercase(letter1);
  s2:=ansilowercase(letter2);
  if (not (s1[1] in ['a'..dichighletter])) or
     (not (s2[1] in ['a'..dichighletter])) then
  begin
     currentwordindex:=words.count;
     exit;
  end;
  startletter:=letter1;
  endletter:=letter2;
  startlength:=length1;
  endlength:=length2;
  currletter:=startletter;
  currlength:=startlength;
  If indexdirty then Rebuildindex;
  currentWordIndex:=LetterIndex[startletter]-1;
  prevword:='';
  currword:='';
End;

(*
 Procedure TDic.Findwords(scrambled:string; NbrToFind:byte; List:Tstrings);
 {given a scrambled word - find up to the specified # of words from
  dictionary and return them in a list}

 var
   c:TComboSet;
   s:string;
   n,i:integer;
   abbrev,foreign:boolean;
 Begin
   n:=length(scrambled);
   s:=scrambled;
   list.clear;
   If n>0 then
   Begin
     c:=TComboSet.create;
     c.init(n,n,false);
     while c.getnext do
     Begin
       for i:=1 to n do s[i]:=scrambled[c.selected[i]];
       if lookup(s,abbrev,foreign)
       then list.add(s);
     end;
     c.free;
   End;
 End;
 *)


 Function TDic.GetwordCount:integer;
 {retrieve and count all words starting with preset letter and length}
 var
   w:string;
   a,f,c:boolean;
   n:integer;
 Begin
   n:=0;
   ExpandedList.clear;
   while Getnextword(w,a,f,c) do
   begin
     ExpandedList.add(w);
     inc(n);
   end;
   result:=n;
 End;



procedure TDicForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  mr:integer;
begin
  canclose:=true;
  If pubdic.dicloaded and pubdic.dicdirty then
  begin
    mr:=pubdic.checksave;
    if mr=mrcancel then canclose:=false;
  end;
  If canclose and privdic.dicloaded and privdic.dicloaded then
  begin
    mr:=privdic.checksave;
    if mr=mrcancel then canclose:=false;
  end;
end;

Initialization
  PubDic:=TDic.Create(false);
  PrivDic:=TDic.Create(false);

end.